• Welcome to Jose's Read Only Forum 2023.
 

Assorted Window API Examples

Started by José Roca, August 29, 2011, 03:33:10 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

José Roca

 
The Windows API, informally WinAPI, is Microsoft's core set of application programming interfaces (APIs) available in the Microsoft Windows operating systems

Win32 is the 32-bit API for modern versions of Windows. The API consists of functions implemented, as with Win16, in system DLLs. The core DLLs of Win32 are kernel32.dll, user32.dll, and gdi32.dll. Win32 was introduced with Windows NT. The version of Win32 that was shipped with Windows 95 was initially referred to as Win32c, with the "c" standing for "compatibility", but this term was later abandoned by Microsoft in favour of Win32.

José Roca

 
The following code displays the class name of all the top-level windows on screen.


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION EnumWindowsProc (BYVAL hwnd AS DWORD, BYVAL lParam AS DWORD) AS LONG

   LOCAL szClassName AS ASCIIZ * 256

   GetClassName hwnd, szClassName, SIZEOF(szClassName)
   ? "Class name = " & szClassName

   FUNCTION = %TRUE

END FUNCTION

FUNCTION PBMAIN () AS LONG

   EnumWindows CODEPTR(EnumWindowsProc), %NULL

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION


José Roca

 
The following code illustrates the use of the EnumChildWindows and EnumChildProc functions. It enumerates all the child windows of the main window or dialog and displays its identifier and class name.


FUNCTION EnumChildProc (BYVAL hwnd AS DWORD, BYVAL lParam AS DWORD) AS LONG

   LOCAL szClassName AS ASCIIZ * 256

   GetClassName hwnd, szClassName, SIZEOF(szClassName)
   MSGBOX "Id = " & FORMAT$(GetDlgCtrlID(hwnd)) & $CRLF & _
          "class name = " & szClassName

   FUNCTION = %TRUE

END FUNCTION

EnumChildWindows hWndMain, CODEPTR(EnumChildProc), %NULL


Note Although the lParam parameter is passed by value, we can use it to return information if we pass a pointer to a variable or structure.


FUNCTION EnumChildProc (BYVAL hwnd AS DWORD, BYVAL lParam AS DWORD PTR) AS LONG

   LOCAL szClassName AS ASCIIZ * 256

   GetClassName hwnd, szClassName, SIZEOF(szClassName)
   IF szClassName = "Internet Explorer_Server" THEN
      IF lParam <> %NULL THEN @lParam = hWnd
      FUNCTION = %FALSE
   ELSE
      FUNCTION = %TRUE
   END IF

END FUNCTION

DIM hwndChild AS DWORD
EnumChildWindows hWndMain, CODEPTR(EnumChildProc), VARPTR(hwndChild)


José Roca

 
The following example uses the GetSystemMetrics function to determine whether a mouse is installed and whether the mouse buttons are swapped. The example also uses the SystemParametersInfo function to retrieve the mouse threshold and speed.


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL fResult AS LONG
   DIM   aMouseInfo(2) AS LONG
   
   fResult = GetSystemMetrics(%SM_MOUSEPRESENT)
   IF fResult = 0 THEN
      ? "No mouse installed."
   ELSE
      ? "mouse installed."
      ' Determine whether the buttons are swapped.
      fResult = GetSystemMetrics(%SM_SWAPBUTTON)
      IF fResult = 0 THEN
         ? "Buttons not swapped."
      ELSE
         ? "Buttons swapped."
      END IF
      ' Get the mouse speed and the threshold values.
      fResult = SystemParametersInfo( _
         %SPI_GETMOUSE, _  ' get mouse information
         0, _              ' not used
         aMouseInfo(0), _  ' holds mouse information
         0)                ' not used
      IF fResult THEN
         ? "Speed: " & STR$(aMouseInfo(2))
         ? "Threshold (x,y): " & STR$(aMouseInfo(0)) & STR$(aMouseInfo(1))
      END IF
   END IF

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION


José Roca

 
The following code enumerates all desktops associated with the current window station of the calling process.


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION EnumDesktopsProc (BYVAL lpszDesktop AS ASCIIZ PTR, BYVAL lParam AS LONG) AS LONG
   ? @lpszDesktop
   FUNCTION = %TRUE
END FUNCTION

FUNCTION PBMAIN () AS LONG

   EnumDesktops GetProcessWindowStation, CODEPTR(EnumDesktopsProc), 0

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION


Unicode version:


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION EnumDesktopsProcW (BYVAL lpwszDesktop AS WSTRINGZ PTR, BYVAL lParam AS LONG) AS LONG
   ? @lpwszDesktop
   FUNCTION = %TRUE
END FUNCTION

FUNCTION PBMAIN () AS LONG

   EnumDesktopsW GetProcessWindowStation, CODEPTR(EnumDesktopsProcW), 0

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION


José Roca

 
The following example illustrates the use of the GetKeyboardType function.


' SED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL s AS STRING

   hr = GetKeyboardType(0)
   SELECT CASE hr
      CASE 1 : s = "IBM PC/XT or compatible (83-key) keyboard"
      CASE 2 : s = "Olivetti ""ICO"" (102-key) keyboard"
      CASE 3 : s = "IBM PC/AT (84-key) or similar keyboard"
      CASE 4 : s = "IBM enhanced (101- or 102-key) keyboard"
      CASE 5 : s = "Nokia 1050 and similar keyboards"
      CASE 6 : s = "Nokia 9140 and similar keyboards"
      CASE 7 : s = "Japanese keyboard"
   END SELECT
   PRINT "Keyboard type: " hr, s
   hr = GetKeyboardType(1)
   PRINT "Keyboard subtype: " hr
   hr = GetKeyboardType(2)
   PRINT "Number of function keys: " hr

   WAITKEY$

END FUNCTION


José Roca

 
The following example enumerates all the resources of kernel32.dll.


' SED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"

FUNCTION EnumResNameProc (BYVAL hModule AS DWORD, BYVAL lpszType AS ASCIIZ PTR, BYVAL lpszName AS ASCIIZ PTR, BYVAL lParam AS LONG) AS LONG

   LOCAL strType AS STRING
   LOCAL strName AS STRING

   IF (lpszType AND &HFFFF0000) THEN
      strType = @lpszType
   ELSE
      strType = "#" + FORMAT$(lpszType)
   END IF
   IF (lpszName AND &HFFFF0000) THEN
      strName = @lpszName
   ELSE
      strName = "#" + FORMAT$(lpszName)
   END IF

   PRINT "Type: " strType
   PRINT "Name: " strName

   FUNCTION = %TRUE

END FUNCTION

FUNCTION PBMAIN () AS LONG

   LOCAL szLib AS ASCIIZ * %MAX_PATH
   LOCAL dwHandle AS DWORD
   LOCAL i AS LONG
   
   szLib = "C:\Windows\System32\kernel32.dll"   ' --> change it
   dwHandle = LoadLibraryEx(szLib, 0, %LOAD_LIBRARY_AS_DATAFILE)
   IF dwHandle = 0 THEN
      PRINT "Invalid library"
   ELSE
      FOR i = 1 TO 24  ' From RT_CURSOR to RT_MANIFEST
         EnumResourceNames dwHandle, BYVAL i, CODEPTR(EnumResNameProc), 0
      NEXT
   END IF
   FreeLibrary dwHandle
   WAITKEY$

END FUNCTION


José Roca

 
The following code shows a simple use of the GlobalMemoryStatus function.


' SED_PBCC - User the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL stat AS MEMORYSTATUS

   GlobalMemoryStatus stat

   STDOUT "The MEMORYSTATUS structure is " & FORMAT$(stat.dwLength) & _
          " bytes long; it should be " & FORMAT$(SIZEOF(stat))
   STDOUT "There is " & FORMAT$(stat.dwMemoryLoad) & " percent of memory in use."
   STDOUT "There are " & FORMAT$(stat.dwTotalPhys\1024) & " total Kbytes of physical memory."
   STDOUT "There are " & FORMAT$(stat.dwAvailPhys\1024) & " free Kbytes of physical memory."
   STDOUT "There are " & FORMAT$(stat.dwTotalPageFile\1024) & " total Kbytes of paging file."
   STDOUT "There are " & FORMAT$(stat.dwAvailPageFile\1024) & " free Kbytes of paging file."
   STDOUT "There are " & FORMAT$(stat.dwTotalVirtual\1024) & " total Kbytes of virtual memory."
   STDOUT "There are " & FORMAT$(stat.dwAvailVirtual\1024) & " free Kbytes of virtual memory."

   WAITKEY$

END FUNCTION


José Roca

 
The following code shows a simple use of the GlobalMemoryStatusEx function.


' SED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL nError AS LONG
   LOCAL statex AS MEMORYSTATUSEX

   statex.dwLength = SIZEOF(statex)
   hr = GlobalMemoryStatusEx(statex)
   nError = GetLastError
   IF hr = 0 THEN
      STDOUT "Error: &H" & HEX$(nError)
   ELSE
      STDOUT "There is " & FORMAT$(statex.dwMemoryLoad) & " percent of memory in use."
      STDOUT "There are " & FORMAT$(statex.ullTotalPhys\1024) & " total Kbytes of physical memory."
      STDOUT "There are " & FORMAT$(statex.ullAvailPhys\1024) & " free Kbytes of physical memory."
      STDOUT "There are " & FORMAT$(statex.ullTotalPageFile\1024) & " total Kbytes of paging file."
      STDOUT "There are " & FORMAT$(statex.ullAvailPageFile\1024) & " free Kbytes of paging file."
      STDOUT "There are " & FORMAT$(statex.ullTotalVirtual\1024) & " total Kbytes of virtual memory."
      STDOUT "There are " & FORMAT$(statex.ullAvailVirtual\1024) & " free Kbytes of virtual memory."
      ' Show the amount of extended memory available.
      STDOUT "There are " & FORMAT$(statex.ullAvailExtendedVirtual\1024) & " free Kbytes of extended memory."
   END IF

   WAITKEY$

END FUNCTION


José Roca

 
The following example displays the names of all the active services.


' ########################################################################################
' The following example displays the names of all the active services.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL hSCM AS DWORD
   LOCAL dwServiceType AS DWORD
   LOCAL cbBytesNeeded AS DWORD
   LOCAL dwServicesReturned AS DWORD
   LOCAL hNextUnreadEntry AS DWORD
   LOCAL dwStructsNeeded AS DWORD
   LOCAL dwServiceStatusInfoBuffer AS DWORD
   LOCAL i AS LONG
   DIM   rgEnumServiceStatus(0) AS ENUM_SERVICE_STATUS

   hSCM = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_ENUMERATE_SERVICE)
   IF hSCM = 0 THEN
      PRINT "OpenSCManager failed. Error" & STR$(GetLastError)
      WAITKEY$
      EXIT FUNCTION
   END IF

   dwServiceType = %SERVICE_ACTIVE
   hr = EnumServicesStatus(hSCM, %SERVICE_WIN32, dwServiceType, BYVAL %NULL, &H0, _
            cbBytesNeeded, dwServicesReturned, hNextUnreadEntry)

   ' We should receive %MORE_DATA error
   IF GetLastError <> %ERROR_MORE_DATA THEN
      PRINT "EnumServicesStatus failed. Error" & STR$(GetLastError)
      CloseServiceHandle hSCM
      WAITKEY$
      EXIT FUNCTION
   END IF

   ' Calculate the number of structures needed
   dwStructsNeeded = cbBytesNeeded \ SIZEOF(ENUM_SERVICE_STATUS) + 1
   ' Redimension the array according to our calculation
   REDIM rgEnumServiceStatus(dwStructsNeeded - 1)
   ' Calculate the buffer size in bytes
   dwServiceStatusInfoBuffer = dwStructsNeeded * SIZEOF(ENUM_SERVICE_STATUS)
   ' Get services information starting entry 0
   hr = EnumServicesStatus(hSCM, _
                           %SERVICE_WIN32, _
                           dwServiceType, _
                           rgEnumServiceStatus(0), _
                           dwServiceStatusInfoBuffer, _
                           cbBytesNeeded, _
                           dwServicesReturned, _
                           hNextUnreadEntry)
   IF hr = 0 THEN
      PRINT "EnumServicesStatus failed. Error" & STR$(GetLastError)
      CloseServiceHandle hSCM
      WAITKEY$
      EXIT FUNCTION
   END IF

   FOR i = 0 TO dwServicesReturned - 1
      PRINT "Service name = " rgEnumServiceStatus(i).@lpServiceName
      PRINT "Display name = " rgEnumServiceStatus(i).@lpDisplayName
   NEXT

   CloseServiceHandle hSCM

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

 
The following example enumerates all the resource types of kernel32.dll.


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

FUNCTION EnumResTypeProc (BYVAL hModule AS DWORD, BYVAL lpszType AS ASCIIZ PTR,BYVAL lParam AS LONG) AS LONG

   LOCAL strType AS STRING

   IF (lpszType AND &HFFFF0000) THEN
      strType = @lpszType
   ELSE
      strType = "#" + FORMAT$(lpszType)
   END IF

   ? "Type: " & strType

   FUNCTION = %TRUE

END FUNCTION

FUNCTION PBMAIN () AS LONG

   LOCAL szLib AS ASCIIZ * %MAX_PATH
   LOCAL dwHandle AS DWORD
   LOCAL i AS LONG
   
   szLib = "C:\Windows\System32\kernel32.dll"   ' --> change it
   dwHandle = LoadLibraryEx(szLib, 0, %LOAD_LIBRARY_AS_DATAFILE)
   IF dwHandle = 0 THEN
      ? "Invalid library"
   ELSE
      EnumResourceTypes dwHandle, CODEPTR(EnumResTypeProc), 0
   END IF
   FreeLibrary dwHandle

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION


José Roca

 
The following example uses FlashWindow to flash a window and MessageBeep to play the system exclamation sound.


' ########################################################################################
' The following example uses FlashWindow to flash a window and MessageBeep to play the
' system exclamation sound.
' ########################################################################################

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hwndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "FlashWindow"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "FlashWindowDemo"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hwndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   hCtl = CreateWindowEx(0, "BUTTON", "&Flash", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hwndMain, %IDOK, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hwndMain, %IDCANCEL, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' Message handler loop
   LOCAL Msg AS tagMsg
   WHILE GetMessage(Msg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hwndMain, Msg) THEN
         TranslateMessage Msg
         DispatchMessage Msg
      END IF
   WEND

   FUNCTION = msg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL rc AS RECT

   SELECT CASE wMsg

      CASE %WM_SIZE
         ' Resize the two sample buttons of the dialog
         IF wParam <> %SIZE_MINIMIZED THEN
            GetClientRect hwnd, rc
            MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
            MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  FlashWindow(hwnd, %TRUE)  ' invert the title bar
                  Sleep(500)                ' wait a bit
                  FlashWindow(hwnd, %TRUE)  ' invert again
                  ' Play the system exclamation sound.
                  MessageBeep(%MB_ICONEXCLAMATION)
               END IF

            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

 
The following example uses FlashWindowEx to flash a window and MessageBeep to play the system exclamation sound.


' ########################################################################################
' The following example uses FlashWindowEx to flash a window and MessageBeep to play the
' system exclamation sound.
' ########################################################################################

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hwndMain AS DWORD
   LOCAL hCtl AS DWORD
   LOCAL hFont AS DWORD
   LOCAL wcex AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc AS RECT
   LOCAL szCaption AS ASCIIZ * 255
   LOCAL nLeft AS LONG
   LOCAL nTop AS LONG
   LOCAL nWidth AS LONG
   LOCAL nHeight AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "FlashWindowEx"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

   ' Window caption
   szCaption = "FlashWindowEx Demo"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0

   ' Calculate the position and size of the window
   nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.75   ' 75% of the client screen width
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70   ' 70% of the client screen height
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hwndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_OVERLAPPEDWINDOW OR _
                             %WS_CLIPCHILDREN, _               ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   hCtl = CreateWindowEx(0, "BUTTON", "&Flash", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hwndMain, %IDOK, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hwndMain, %IDCANCEL, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hwndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL rc AS RECT
   LOCAL fwi AS FLASHWINFO

   SELECT CASE wMsg

      CASE %WM_SIZE
         ' Resize the two sample buttons of the dialog
         IF wParam <> %SIZE_MINIMIZED THEN
            GetClientRect hwnd, rc
            MoveWindow GetDlgItem(hwnd, %IDOK), (rc.nRight - rc.nLeft) - 185, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
            MoveWindow GetDlgItem(hwnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  fwi.cbSize = SIZEOF(FLASHWINFO)
                  fwi.hwnd = hwnd
                  fwi.dwFlags = %FLASHW_ALL
                  fwi.uCount = 3
                  FlashWindowEx(fwi)
                  SLEEP(500)
                  ' Play the system exclamation sound.
                  MessageBeep(%MB_ICONEXCLAMATION)
               END IF

            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

 
The following example demonstrates how to query a Windows Service's Status and Configuration from PowerBASIC.

It is an adaptation of the following Knowledge Base article: http://support.microsoft.com/kb/189633


' ########################################################################################
' How To Query a Service for Status and Configuration
' http://support.microsoft.com/kb/189633
' ########################################################################################

' SED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL hSCM AS DWORD
   LOCAL hSVC AS DWORD
   LOCAL pSTATUS AS SERVICE_STATUS
   LOCAL strTemp AS STRING
   LOCAL cbBytesNeeded AS DWORD
   LOCAL udtConfig AS QUERY_SERVICE_CONFIG

   hSCM = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_CONNECT)
   IF hSCM = 0 THEN
      PRINT "OpenSCManager failed. Error" & STR$(GetLastError)
      WAITKEY$
      EXIT FUNCTION
   END IF

   ' Open the specific Service to obtain a handle
   hSVC = OpenService(hSCM, "EventLog", %GENERIC_READ)
   IF hSVC = 0 THEN
      PRINT "OpenSCManager failed. Error" & STR$(GetLastError)
      GOTO CloseHandles
   END IF

   ' Fill the Service Status Structure
   hr = QueryServiceStatus(hSVC, pSTATUS)
   IF hr = 0 THEN
      PRINT "OpenSCManager failed. Error" & STR$(GetLastError)
      GOTO CloseHandles
   END IF

   ' Report the Current State
   SELECT CASE pSTATUS.dwCurrentState
      CASE %SERVICE_STOPPED
         strTemp = "The Service is Stopped"
      CASE %SERVICE_START_PENDING
         strTemp = "The Service Being Started"
      CASE %SERVICE_STOP_PENDING
         strTemp = "The Service is in the process of being stopped"
      CASE %SERVICE_RUNNING
         strTemp = "The Service is Running"
      CASE %SERVICE_CONTINUE_PENDING
         strTemp = "The Service is in the process of being Continued"
      CASE %SERVICE_PAUSE_PENDING
         strTemp = "The Service is in the process of being Paused"
      CASE %SERVICE_PAUSED
         strTemp = "The Service is Paused"
      CASE %SERVICE_ACCEPT_STOP
         strTemp = "The Service is Stopped"
      CASE %SERVICE_ACCEPT_PAUSE_CONTINUE
         strTemp = "The Service is "
      CASE %SERVICE_ACCEPT_SHUTDOWN
         strTemp = "The Service is being Shutdown"
   END SELECT

   PRINT strTemp

   ' Call QueryServiceConfig to retrieve the size of a buffer we need
   hr = QueryServiceConfig(hSVC, BYVAL %NULL, 0, cbBytesNeeded)
   IF hr = 0 AND GetLastError <> %ERROR_INSUFFICIENT_BUFFER THEN
      PRINT "Error: " & STR$(GetLastError)
      GOTO CloseHandles
   END IF

   ' Redim our byte array to the size necessary and call QueryServiceConfig again
   REDIM abConfig(cbBytesNeeded) AS BYTE
   hr = QueryServiceConfig(hSVC, abConfig(0), cbBytesNeeded, cbBytesNeeded)
   IF hr = 0 THEN
      PRINT "Error: " & STR$(GetLastError)
      GOTO CloseHandles
   END IF

   ' Fill our Service Config User Defined Type
   RtlCopyMemory udtConfig, abConfig(0), LEN(udtConfig)

   PRINT "Service Type: " & STR$(udtConfig.dwServiceType)
   PRINT "Service Start Type: " & STR$(udtConfig.dwStartType)
   PRINT "Service Error Control: " & STR$(udtConfig.dwErrorControl)
   PRINT "Service Binary Path: " & udtConfig.@lpBinaryPathName
   PRINT "Service Dependencies: " & udtConfig.@lpDependencies
   PRINT "Service DisplayName: " & udtConfig.@lpDisplayName
   PRINT "Service LoadOrderGroup: " & udtConfig.@lpLoadOrderGroup
   PRINT "Service Start Name: " & udtConfig.@lpServiceStartName

CloseHandles:

   ' Close the Handle to the Service
   IF hSVC THEN CloseServiceHandle(hSVC)
   ' Close the Handle to the Service Control Manager
   IF hSCM THEN CloseServiceHandle(hSCM)

   WAITKEY$

END FUNCTION
' ========================================================================================


José Roca

 
The time functions included in the C run-time use the time_t type to represent the number of seconds elapsed since midnight, January 1, 1970. The following example converts a time_t value to a file time.

C Example


#include <windows.h>
#include <time.h>

void TimetToFileTime( time_t t, LPFILETIME pft )
{
    LONGLONG ll = Int32x32To64(t, 10000000) + 116444736000000000;
    pft->dwLowDateTime = (DWORD) ll;
    pft->dwHighDateTime = ll >>32;
}


The Int32x32To64 macro is defined as follows:


#define Int32x32To64(a, b) ((LONGLONG)((LONG)(a)) * (LONGLONG)((LONG)(b)))


After you have obtained a file time, you can convert this value to system time using the FileTimeToSystemTime function.

PowerBASIC Example


#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"
#INCLUDE "time.inc"

SUB TimetToFileTime (BYVAL t AS LONG, BYREF ft AS FILETIME)
   LOCAL q AS QUAD
   q = (t * 10000000&&) + 116444736000000000&&
   ft.dwLowDateTime = CDWD(q)
   SHIFT RIGHT q, 32
   ft.dwHighDateTime = q
END SUB

FUNCTION PBMAIN () AS LONG

   LOCAL t AS LONG
   LOCAL ft AS FILETIME
   LOCAL st AS SYSTEMTIME

   time(t)
   TimetToFileTime(t, ft)
   FileTimeToSystemTime(ft, st)
   MSGBOX STR$(st.wDay) & STR$(st.wMonth) & STR$(st.wYear)

END FUNCTION