Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg as DWord
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Push", 50,10,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
RegisterProgram
End If
End Function
'
' ddoc_reg.bas
'
' Registry functions for ddoc.exe
'
' RegOpenSection
' RegClose
' RegSetString
' IsDDCRegistered
' RegisterDDOC
'
'------------------------------------------------------------------------------
'
' RegOpenSection
'------------------------------------------------------------------------------
Function RegOpenSection (ByVal Key As Long, Section As Asciiz) As Long
Dim hKey As Long
Dim Result As Long
' Create the section
If RegCreateKeyEx(Key, Section, 0, "", %REG_OPTION_NON_VOLATILE, _
%KEY_ALL_ACCESS, ByVal %NULL, hKey, Result) <> %ERROR_SUCCESS Then
Exit Function
End If
'- Return the registry key handle
Function = hKey
End Function
'
' RegClose
'------------------------------------------------------------------------------
Function RegClose (ByVal hKey As Long) As Long
RegCloseKey hKey
End Function
'
' RegSetString
'------------------------------------------------------------------------------
Function RegSetString (ByVal hKey As Long, Entry As Asciiz, Value As Asciiz) As Long
'- Save the value for the entry
If Len(Value) Then
Function = RegSetValueEx(hKey, Entry, 0, %REG_SZ, Value, Len(Value) + 1)
Else
Function = RegSetValueEx(hKey, Entry, 0, %REG_SZ, ByVal %NULL, 0)
End If
End Function
'
' IsDDCRegistered
'------------------------------------------------------------------------------
Function IsDDCRegistered() As Long
Dim hKey As Long
Dim zExtension As Asciiz * 10
Dim zBuffer As Asciiz * 300
zExtension = ".ddc"
'- Open the key
hKey = RegOpenSection(%HKEY_CLASSES_ROOT, zExtension)
If IsFalse(hKey) Then
Exit Function
End If
'- Check it's value
If RegQueryValueEx(hKey, "", 0, %REG_SZ, zBuffer, SizeOf(zBuffer) - 1) = %ERROR_SUCCESS Then
'ShowMessage "zBuffer = " + zBuffer
If Trim$(zBuffer) = "" Then
Function = %False
Else
Function = %True
End If
Else
Function = %False
End If
RegClose hKey
End Function
'
' RegisterProgram
'
' This function puts ddoc in the registry and associates the .ddc
' extension with ddoc.exe.
'
' It is called like this:
'
' RegisterProgram ".ddc", "ddoc Document", "c:\windows\system\ddoc.exe %1", _
' "c:\windows\system\ddoc.exe -PA %1"
'------------------------------------------------------------------------------
Function RegisterProgram() As Long
Dim hKey As Long
Dim zExtension As Asciiz * 10
Dim zDescription As Asciiz * 50
Dim zOpen As Asciiz * 300
Dim zPrint As Asciiz * 300
'- Set the variables for ddoc
zExtension = ".gbs"
zDescription = "gbSnippets Library"
zOpen = "c:\Data\apps\powerbasic\apps_gbapps\gbsnippets\gbsnippets.exe" + " %1"
zPrint = "" 'not used
'- Write out extension
hKey = RegOpenSection(%HKEY_CLASSES_ROOT, zExtension)
If IsFalse(hKey) Then
Exit Function
End If
RegSetString hKey, "", zDescription
RegClose hKey
'- Write out description
hKey = RegOpenSection(%HKEY_CLASSES_ROOT, zDescription)
If IsFalse(hKey) Then
Exit Function
End If
RegSetString hKey, "", zDescription
RegClose hKey
'- The open instruction
hKey = RegOpenSection(%HKEY_CLASSES_ROOT, Trim$(zDescription) + "\shell\open\command")
If IsFalse(hKey) Then
Exit Function
End If
RegSetString hKey, "", zOpen
RegClose hKey
' '- The Close instruction
' hKey = RegOpenSection(%HKEY_CLASSES_ROOT, Trim$(zDescription) + "\shell\print\command")
'
' If IsFalse(hKey) Then
' Exit Function
' End If
'
' RegSetString hKey, "", zPrint
' RegClose hKey
Function = %True
End Function
'gbs_00548
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm