Some small procedures usefull in Windows programming

DEFINITION MODULE WinUtils;

(* Some usefull small procedures for Windows programming
   with Stony Brook Modula-2

   Frank Schoonjans

   http://www.modula2.org                                   *)


IMPORT WIN32;

(* ******************************************************************************** *)

(* Retrieves text for the numeric error code returned by the Windows
   GetLastError() function, and displays it in a message box *)
PROCEDURE AlertWindowsError(errornr : INTEGER);

(* ******************************************************************************** *)

(* Get Windows major, minor and build version number;
   returns major build number for convenience            *)
PROCEDURE GetWindowsVersion(VAR major,minor,build : INTEGER): INTEGER;

(* ******************************************************************************** *)

(* Retrieves the default browser executable *)
PROCEDURE GetDefaultBrowser(VAR browserprog : ARRAY OF CHAR): BOOLEAN;

(* ******************************************************************************** *)

(* Opens the default browser - in a new window - with the given URL *)
PROCEDURE LaunchURL(url : ARRAY OF CHAR): BOOLEAN;

(* ******************************************************************************** *)

(* Use this procedure to disable a control in a dialog box
   See: <a href="http://weblogs.asp.net/oldnewthing/archive/2004/08/04/208005.aspx">http://weblogs.asp.net/oldnewthing/archive/2004/08/04/208005.aspx</a> *)
PROCEDURE DialogDisableWindow(hdlg, hwndControl : WIN32.HWND);

(* ******************************************************************************** *)

CONST CSIDL_PERSONAL      = 0005H; (* Use this for the My Documents folder *)
      CSIDL_APPDATA       = 001AH;
      CSIDL_PROGRAM_FILES = 0026H;

      (* For description and other values see: <a href="http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/enums/csidl.asp">Microsoft MSDN</a> *)

PROCEDURE GetSystemFolder(csidl : INTEGER; VAR path : ARRAY OF CHAR): BOOLEAN;


END WinUtils.

IMPLEMENTATION MODULE WinUtils;

IMPORT WIN32,WINUSER,WINREG,WINX,WINERROR;

IMPORT Strings;

IMPORT ExStrings,RunProg;

FROM SYSTEM IMPORT CAST,FUNC;


(* *********************************************************************** *)
(* Retrieves text for the numeric error code returned by the Windows
   GetLastError() function, and displays it in a message box *)
PROCEDURE AlertWindowsError(errornr : INTEGER);
VAR str : ARRAY [0..WIN32.MAX_PATH] OF CHAR;
BEGIN
    FUNC WIN32.FormatMessage(    WIN32.FORMAT_MESSAGE_FROM_SYSTEM
                             BOR WIN32.FORMAT_MESSAGE_IGNORE_INSERTS,
                             NIL,errornr,0,str,HIGH(str)+1,NIL);
    FUNC WINUSER.MessageBox(NIL,str,"Error",0);
END AlertWindowsError;


(* *********************************************************************** *)
(* Get Windows major, minor and build version number;
   returns major build number for convenience            *)
PROCEDURE GetWindowsVersion(VAR major,minor,build : INTEGER): INTEGER;
VAR OsVersion : WIN32.OSVERSIONINFO;
BEGIN
    OsVersion.dwOSVersionInfoSize:=SIZE(OsVersion);
    FUNC WIN32.GetVersionEx(OsVersion);
    major:=OsVersion.dwMajorVersion;
    minor:=OsVersion.dwMinorVersion;
    build:=WINUSER.LOWORD(OsVersion.dwBuildNumber);
    RETURN OsVersion.dwMajorVersion;
END GetWindowsVersion;


(* *********************************************************************** *)
(* Retrieves the default browser executable *)
PROCEDURE GetDefaultBrowser(VAR browserprog : ARRAY OF CHAR): BOOLEAN;
VAR key   : WINREG.HKEY;
    count : CARDINAL;
    ok    : BOOLEAN;
    type  : CARDINAL;
    pos   : CARDINAL;
    res   : INTEGER;
    path  : ARRAY [0..WIN32.MAX_PATH] OF CHAR;
BEGIN
    browserprog:="";
    res:=WINREG.RegOpenKeyEx(WINREG.HKEY_CLASSES_ROOT,
                             "HTTP\shell\open\command",0,WIN32.KEY_READ,key);
    IF  ~(res= WINERROR.ERROR_SUCCESS) THEN RETURN FALSE END;

    count := HIGH(path)+1;
    res   := WINREG.RegQueryValueEx(key,"",WINX.NIL_DWORD,type,path,count);
    FUNC WINREG.RegCloseKey(key);
    IF ~( (res=WINERROR.ERROR_SUCCESS) AND (type=WIN32.REG_SZ) ) THEN RETURN FALSE END;

    IF path[0]='"' THEN Strings.Delete(path,0,1) END;
    ExStrings.FindNextI(".exe",path,0,ok,pos);
    IF ~ok THEN RETURN FALSE END;
    path[pos+4]:=00C; (* truncate after '.exe' *)
    Strings.Assign(path,browserprog);
    RETURN TRUE;
END GetDefaultBrowser;


(* *********************************************************************** *)
(* Opens the default browser - in a new window - with the given URL *)
PROCEDURE LaunchURL(url : ARRAY OF CHAR): BOOLEAN;
VAR path   :  ARRAY [0..WIN32.MAX_PATH] OF CHAR;
    status : CARDINAL;
BEGIN
    IF ~GetDefaultBrowser(path) THEN RETURN FALSE END;
    RETURN RunProg.RunProgram(path,url,"",RunProg.AsyncExec,status);
END LaunchURL;


(* *********************************************************************** *)
(* Use this procedure to disable a control in a dialog box
   See: http://weblogs.asp.net/oldnewthing/archive/2004/08/04/208005.aspx *)
PROCEDURE DialogDisableWindow(hdlg, hwndControl : WIN32.HWND);
BEGIN
    IF (hwndControl = WINUSER.GetFocus()) THEN
       FUNC WINUSER.SendMessage(hdlg, WINUSER.WM_NEXTDLGCTL, 0, 0 );
    END;
    FUNC WINUSER.EnableWindow(hwndControl, FALSE);
END DialogDisableWindow;


(* *********************************************************************** *)
<*/PUSH*>
<*/CALLS:WIN32SYSTEM*>
<*/NOHIGH*>
<*/ALIGN:8/NOPACK*>
TYPE GetFolderProc = PROCEDURE (WIN32.HWND, INTEGER, WIN32.HANDLE, WIN32.DWORD,
                                VAR ARRAY OF CHAR);
<*/POP*>

PROCEDURE GetSystemFolder(csidl : INTEGER; VAR path : ARRAY OF CHAR): BOOLEAN;
CONST SHGFP_TYPE_CURRENT = 0;
VAR hinst   : WIN32.HINSTANCE;
    proc    : GetFolderProc;
BEGIN
    path:="";
    hinst:=WIN32.LoadLibrary("shfolder.dll");
    IF CAST(INTEGER,hinst)=0 THEN RETURN FALSE END;
    %IF UNICODE %THEN
      proc:=CAST(GetFolderProc,WIN32.GetProcAddress(hinst,"SHGetFolderPathW"));
    %ELSE
      proc:=CAST(GetFolderProc,WIN32.GetProcAddress(hinst,"SHGetFolderPathA"));
    %END;
    IF proc=CAST(GetFolderProc,NIL) THEN RETURN FALSE END;
    proc(NIL,csidl,NIL,SHGFP_TYPE_CURRENT,path);
    FUNC WIN32.FreeLibrary(hinst);
    RETURN TRUE;
END GetSystemFolder;


END WinUtils.