PBMiner

$PBExportHeader$n_appobject.sru
forward
global type n_appobject from nonvisualobject
end type
end forward

global type n_appobject from nonvisualobject autoinstantiate
end type

type prototypes
Function boolean ShowWindow ( &
   longptr hWnd, &
   long nCmdShow &
   ) Library "user32.dll"

Function longptr MonitorFromWindow ( &
   longptr hwnd, &
   ulong dwFlags &
   ) Library "user32.dll"
   
Function ulong GetModuleFileName ( &
   longptr hModule, &
   ref string lpFileName, &
   ulong nSize &
   ) Library "kernel32.dll" Alias For "GetModuleFileNameW"

Function boolean IsUserAnAdmin ( &
   ) Library "shell32.dll"

Function long SHGetFolderPath ( &
   longptr hwnd, &
   long csidl, &
   longptr hToken, &
   ulong dwFlags, &
   Ref string pszPath &
   ) Library "shell32.dll" Alias For "SHGetFolderPathW"

Subroutine SHChangeNotify ( &
   long wEventId, &
   ulong uFlags, &
   long dwItem1, &
   long dwItem2 &
   ) Library "shell32.dll" Alias For "SHChangeNotify"

end prototypes

type variables
String REGISTRYKEY = "HKEY_CURRENT_USER\Software\Topwiz\PSRViewer"

end variables

forward prototypes
public subroutine of_showwindow (window aw_window, windowstate ae_state)
public function string of_getreg (string as_subkey, string as_valuename, string as_default)
public function string of_getreg (string as_valuename, string as_default)
public subroutine of_setreg (string as_subkey, string as_valuename, string as_value)
public subroutine of_setreg (string as_valuename, string as_value)
public subroutine of_delregkey (string as_subkey)
public function boolean of_isonmonitor (window aw_window)
public function long of_parse (string as_text, string as_sep, ref string as_array[])
public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace)
public function string of_getexefilename ()
public subroutine of_registerpsr ()
public function string of_getfolderpath (string as_folder)
end prototypes

public subroutine of_showwindow (window aw_window, windowstate ae_state);// this function sets the windowstate

Long ll_cmdshow
Longptr ll_hWnd

ll_hWnd = Handle(aw_window)

CHOOSE CASE ae_state
   CASE Maximized!
      ll_cmdshow = 3
   CASE Minimized!
      ll_cmdshow = 2
   CASE Normal!
      ll_cmdshow = 1
END CHOOSE

ShowWindow(ll_hWnd, ll_cmdshow)

aw_window.SetFocus()

end subroutine

public function string of_getreg (string as_subkey, string as_valuename, string as_default);// -----------------------------------------------------------------------------
// SCRIPT:     of_GetReg
//
// PURPOSE:    This function returns a string value from the registry.
//
// ARGUMENTS:  as_subkey      - Optional subkey under the base key
//             as_valuename   - Name of the value
//             as_default     - Default to return if not found
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/13/2006  RolandS     Initial Coding
// -----------------------------------------------------------------------------

String ls_regkey, ls_value

If as_subkey = "" Then
   ls_regkey = REGISTRYKEY
Else
   ls_regkey = REGISTRYKEY + "\" + as_subkey
End If

RegistryGet(ls_regkey, as_valuename, RegString!, ls_value)
If IsNull(ls_value) Or ls_value = "" Then
   Return as_default
Else
   Return ls_value
End If

end function

public function string of_getreg (string as_valuename, string as_default);// -----------------------------------------------------------------------------
// SCRIPT:     of_GetReg
//
// PURPOSE:    This function returns a string value from the registry.
//
// ARGUMENTS:  as_valuename   - Name of the value
//             as_default     - Default to return if not found
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/13/2006  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Return of_GetReg("", as_valuename, as_default)

end function

public subroutine of_setreg (string as_subkey, string as_valuename, string as_value);// -----------------------------------------------------------------------------
// SCRIPT:     of_SetReg
//
// PURPOSE:    This function saves string values in the registry.
//
// ARGUMENTS:  as_subkey      - Optional subkey under the base key
//             as_valuename   - Name of the value
//             as_value       - The value to save
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/13/2006  RolandS     Initial Coding
// -----------------------------------------------------------------------------

String ls_regkey, ls_value

If as_subkey = "" Then
   ls_regkey = REGISTRYKEY
Else
   ls_regkey = REGISTRYKEY + "\" + as_subkey
End If

RegistrySet(ls_regkey, as_valuename, RegString!, as_value)

end subroutine

public subroutine of_setreg (string as_valuename, string as_value);// -----------------------------------------------------------------------------
// SCRIPT:     of_SetReg
//
// PURPOSE:    This function saves string values in the registry.
//
// ARGUMENTS:  as_valuename   - Name of the value
//             as_value       - The value to save
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/13/2006  RolandS     Initial Coding
// -----------------------------------------------------------------------------

of_SetReg("", as_valuename, as_value)

end subroutine

public subroutine of_delregkey (string as_subkey);// -----------------------------------------------------------------------------
// SCRIPT:     of_DelRegKey
//
// PURPOSE:    This function deletes a subkey from the registry.
//
// ARGUMENTS:  as_subkey   - Optional subkey under the base key
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 08/28/2016  RolandS     Initial Coding
// -----------------------------------------------------------------------------

String ls_regkey

If as_subkey = "" Then
   ls_regkey = REGISTRYKEY
Else
   ls_regkey = REGISTRYKEY + "\" + as_subkey
End If

RegistryDelete(ls_regkey, "")

end subroutine

public function boolean of_isonmonitor (window aw_window);// -----------------------------------------------------------------------------
// SCRIPT:     of_IsOnMonitor
//
// PURPOSE:    This function determines if the window is currently visible
//             on one of the monitors.
//
// ARGUMENTS:  aw_window   - Window to check the location
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 05/10/2019  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Constant ULong MONITOR_DEFAULTTONULL = 0
Longptr ll_hWnd, ll_handle

ll_hWnd = Handle(aw_window)

ll_handle = MonitorFromWindow(ll_hWnd, MONITOR_DEFAULTTONULL)
If ll_handle = 0 Then
   Return False
End If

Return True

end function

public function long of_parse (string as_text, string as_sep, ref string as_array[]);// ----------------------------------------------------------------------------------------
// SCRIPT:     of_Parse
//
// PURPOSE:    This function parses a string into an array.
//
// ARGUMENTS:  as_text  - The object that was clicked on
//             as_sep   - The separator characters
//             as_array - By ref output array
//
// RETURN:     The number of items in the array
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 03/27/2015  RolandS     Initial Coding
// -----------------------------------------------------------------------------

String ls_empty[], ls_work
Long ll_pos, ll_each

as_array = ls_empty

If IsNull(as_text) Or as_text = "" Then Return 0

ll_pos = Pos(as_text, as_sep)
DO WHILE ll_pos > 0
   ls_work = Trim(Left(as_text, ll_pos - 1))
   as_text = Trim(Mid(as_text, ll_pos + Len(as_sep)))
   as_array[UpperBound(as_array) + 1] = ls_work
   ll_pos = Pos(as_text, as_sep)
LOOP
If Len(as_text) > 0 Then
   as_array[UpperBound(as_array) + 1] = as_text
End If

Return UpperBound(as_array)

end function

public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace);// -----------------------------------------------------------------------------
// SCRIPT:     of_ReplaceAll
//
// PURPOSE:    This function all of the occurrences of a string within
//             another string.
//
// ARGUMENTS:  as_oldstring   - The string to be updated
//             as_findstr     - The string to look for
//             as_replace     - The replacement string
//
// RETURN:     The updated string
//
// DATE        CHANGED BY  DESCRIPTION OF CHANGE / REASON
// ----------  ----------  -----------------------------------------------------
// 02/17/2010  RolandS     Initial creation
// -----------------------------------------------------------------------------

String ls_newstring
Long ll_findstr, ll_replace, ll_pos

// get length of strings
ll_findstr = Len(as_findstr)
ll_replace = Len(as_replace)

// find first occurrence
ls_newstring = as_oldstring
ll_pos = Pos(ls_newstring, as_findstr)

Do While ll_pos > 0
   // replace old with new
   ls_newstring = Replace(ls_newstring, ll_pos, ll_findstr, as_replace)
   // find next occurrence
   ll_pos = Pos(ls_newstring, as_findstr, (ll_pos + ll_replace))
Loop

Return ls_newstring

end function

public function string of_getexefilename ();// -----------------------------------------------------------------------------
// SCRIPT:     of_GetExeFileName
//
// PURPOSE:    This function returns the full filename of the executable.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 08/28/2016  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Application la_app
Longptr ll_hWnd
String ls_module
ULong lul_rc, lul_size = 260

la_app = GetApplication()
ll_hWnd = Handle(la_app)

ls_module = Space(lul_size)

lul_rc = GetModuleFileName(ll_hWnd, ls_module, lul_size)

Return ls_module

end function

public subroutine of_registerpsr ();// -----------------------------------------------------------------------------
// SCRIPT:     of_RegisterPSR
//
// PURPOSE:    This function registers the .psr file type with the program.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/26/2019  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Constant Long SHCNE_ASSOCCHANGED = 0   // 0x8000000
Constant ULong SHCNF_FLUSH       = 0   // 0x1000
String ls_exefilename, ls_regkey, ls_regvalue

ls_exefilename = this.of_GetExeFileName()

ls_regkey   = "HKEY_CLASSES_ROOT\.psr"
RegistrySet(ls_regkey, "", RegString!, "PSRViewer.psr")

ls_regkey   = "HKEY_CLASSES_ROOT\PSRViewer.psr"
RegistrySet(ls_regkey, "", RegString!, "Powersoft Report")

ls_regkey   = "HKEY_CLASSES_ROOT\PSRViewer.psr\DefaultIcon"
ls_regvalue = ls_exefilename + ',0'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

ls_regkey   = "HKEY_CLASSES_ROOT\PSRViewer.psr\shell\open\command"
ls_regvalue = '"' + ls_exefilename + '" "%1"'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

ls_regkey   = "HKEY_CLASSES_ROOT\Applications\psrviewer.exe\shell\open\command"
ls_regvalue = '"' + ls_exefilename + '" "%1"'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

ls_regkey   = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ApplicationAssociationToasts"
RegistrySet(ls_regkey, "PSRViewer.psr_.psr", ReguLong!, 0)
RegistrySet(ls_regkey, "Applications\psrviewer.exe_.psr", ReguLong!, 0)

ls_regkey   = "HKEY_CURRENT_USER\Software\Classes\.psr"
RegistrySet(ls_regkey, "", RegString!, "PSRViewer.psr")

ls_regkey   = "HKEY_CURRENT_USER\Software\Classes\PSRViewer.psr"
RegistrySet(ls_regkey, "", RegString!, "Powersoft Report")

ls_regkey   = "HKEY_CURRENT_USER\Software\Classes\PSRViewer.psr\shell\open\command"
ls_regvalue = '"' + ls_exefilename + '" "%1"'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

ls_regkey   = "HKEY_CURRENT_USER\Software\Classes\Applications\psrviewer.exe\DefaultIcon"
ls_regvalue = ls_exefilename + ',0'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

ls_regkey   = "HKEY_CURRENT_USER\Software\Classes\Applications\psrviewer.exe\shell\open\command"
ls_regvalue = '"' + ls_exefilename + '" "%1"'
RegistrySet(ls_regkey, "", RegString!, ls_regvalue)

SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, 0, 0)

end subroutine

public function string of_getfolderpath (string as_folder);// -----------------------------------------------------------------------------
// SCRIPT:     of_GetFolderPath
//
// PURPOSE:    This function returns the path to a shell folder.
//
// ARGUMENTS:  as_folder   - Name of the shell folder
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 10/13/2006  RolandS     Initial Coding
// -----------------------------------------------------------------------------

Constant ULong SHGFP_TYPE_CURRENT = 0
Constant Long CSIDL_DESKTOP   = 0
Constant Long CSIDL_PROGRAMS  = 2
Constant Long CSIDL_PERSONAL  = 5
Constant Long CSIDL_FAVORITES = 6
Constant Long CSIDL_STARTUP   = 7
Constant Long CSIDL_RECENT    = 8
Constant Long CSIDL_BITBUCKET = 10
Constant Long CSIDL_APPDATA   = 26

String ls_path
Long ll_rc, ll_csidl
Longptr ll_hWnd

ll_hWnd = Handle(this)

// set the CSIDL
choose case Upper(as_folder)
   case "DESKTOP"
      ll_csidl = CSIDL_DESKTOP
   case "PROGRAMS"
      ll_csidl = CSIDL_PROGRAMS
   case "PERSONAL"
      ll_csidl = CSIDL_PERSONAL
   case "FAVORITES"
      ll_csidl = CSIDL_FAVORITES
   case "STARTUP"
      ll_csidl = CSIDL_STARTUP
   case "RECENT"
      ll_csidl = CSIDL_RECENT
   case "BITBUCKET"
      ll_csidl = CSIDL_BITBUCKET
   case "APPDATA"
      ll_csidl = CSIDL_APPDATA
   case else
      Return ""
end choose

ls_path = Space(260)

ll_rc = SHGetFolderPath(ll_hWnd, ll_csidl, &
            0, SHGFP_TYPE_CURRENT, ls_path)

Return ls_path

end function

on n_appobject.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_appobject.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on