Abaixo seguem alguns exemplos das funções apresentadas acima, onde são efetuadas operações no Registry do Windows.
Neste exemplo:
prog
a = REGINITKEY("HKEY_LOCAL_MACHINE")
b = REGOPENKEY(a,"SOFTWARE")
c = REGOPENKEY(b,"Microsoft")
d = REGOPENKEY(c,"Windows")
e = REGOPENKEY(d,"CurrentVersion")
f = REGOPENKEY(e,"RunServices")
g = RegCreateKey(f,"OpenBASE")
gg = REGOPENKEY(f,"OpenBASE")
h = RegSetKey(gg,"bdsgbd","bdsgbd.exe")
i = RegQueryKey(gg,"bdsgbd")
j = RegCloseKey(gg)
k = PutReg("M","Configuration","Config", "xxxxxx??????xxxxxx")
l = GetReg("M","Configuration","Config",content)
return
Neste exemplo, usamos as informações referentes a produtos instalados e comandamos a remoção dos mesmos.
$nolib
$lentmp=256
prog
public StatusMens
StatusMens = "Press Help / Readme Buttons or use ;
Help in Context for additional information."
Tit_janela="OpenBASE DEMO Version for Windows - ;
Tecnocoop Sistemas - Brazil"
SetWindowText Tit_janela
SetWindowIcon "openb.ico"
set border on
PlaySound (".\docum\musica.wav")
do faz_dlg
proc faz_dlg
func vfy_geral(l)
botao = 1
vl1, vl2, vl3, vl5 = .f.
gbx1=1
public StatusMens
txt01 = "OpenServer.. DBMS Service and DEMO Data Bases"
txt02 = "OpenOPUS.... Developer language for Windows ;
and WEB Applications"
txt03 = "OpenDLLs.... Interface modules for RAD Tools"
txt05 = "SQL OPENBASEServer.. SQL OPENBASE Server and interactive Query"
message StatusMens
Dialog 02,01,73,11
Font "Times New Roman" 1
caption " Welcome to OpenBASE Products Family !"
style WS_POPUP WS_CAPTION WS_SYSMENU ;
DS_FIXEDSYS DS_CONTEXTHELP
help ".\docum\install.hlp"
GroupBox ' Select package to be Uninstalled ;
and press "UnInstall" ' gbx1 01,01,71,09
CheckBox txt01 vl1 03,03,68,01 CONTEXT(11)
CheckBox txt02 vl2 03,04,68,01 CONTEXT(12)
CheckBox txt03 vl3 03,05,68,01 CONTEXT(13)
CheckBox txt05 vl5 03,06,68,01 CONTEXT(15)
Defpushbutton "&UnInstall" botao 03,08,10,-12 IDOK
PushButton "&Readme" NULL 15,08,10,-12 IDOK
PushButton "&Help" NULL 27,08,10,-12 IDOK
PushButton "&CD-Info" NULL 39,08,10,-12 IDOK
PushButton "&Quit" NULL 51,08,10,-12 IDOK
verify vfy_geral (botao, vl1, vl2, vl3, vl5)
EndDialog
quit
func vfy_geral
parameters botao(n), vl1(l), vl2(l), vl3(l), vl5(l)
private content(203)
public StatusMens
do case
case botao = 2 && Readme
cmd_run="notepad.exe .\readme.txt"
run cmd_run
message StatusMens
return .f.
case botao = 3 && Help
cmd_run="notepad.exe .\install.txt"
run cmd_run
Message StatusMens
return .f.
case botao = 4 && CD-Info
cmd_run="notepad.exe .\cd-info.txt"
run cmd_run
Message StatusMens
return .f.
case botao = 5 && Quit
quit
endcase
hk=RegInitKey("HKEY_LOCAL_MACHINE")
h=RegOpenKey(hk,"SOFTWARE")
h1=RegOpenKey(h,"Microsoft")
h2=RegOpenKey(h1,"Windows")
h3=RegOpenKey(h2,"CurrentVersion")
h4=RegOpenKey(h3,"Uninstall")
if vl1
h5=RegOpenKey(h4,"UOpenServerDemo97")
varc=""
varc=RegQueryKey(h5,"UninstallString")
if !empty(varc)
run varc SW_SHOWNORMAL
DisableControl (2)
else
ret=MessageBox("OpenServer not installed ...", ;
"OpenBASE DEMO UnInstall","O","I")
endif
endif
if vl2
h5=RegOpenKey(h4,"UOpenOPUS")
varc=""
varc=RegQueryKey(h5,"UninstallString")
if !empty(varc)
run varc SW_SHOWNORMAL
DisableControl (3)
else
ret=MessageBox("OpenOPUS not installed ...", ;
"OpenBASE DEMO UnInstall","O","I")
endif
endif
if vl3
h5=RegOpenKey(h4,"UOpenDLLs")
varc=""
varc=RegQueryKey(h5,"UninstallString")
if !empty(varc)
run varc SW_SHOWNORMAL
DisableControl (4)
else
ret=MessageBox("OpenDLLs not installed ...", ;
"OpenBASE DEMO UnInstall","O","I")
endif
endif
if vl5
h5=RegOpenKey(h4,"USQL OPENBASEDemo97")
varc=""
varc=RegQueryKey(h5,"UninstallString")
if !empty(varc)
run varc SW_SHOWNORMAL
DisableControl (5)
else
ret=MessageBox("SQL OPENBASEServer not installed ...", ;
"OpenBASE DEMO UnInstall","O","I")
endif
endif
Message StatusMens
return .f.