- File CAfxProtableDevices changed to CAfxPortableDevices. It was a typo.
- CWindow_InputBox function (CWindow.inc file)
Added the optional parameter bPassword. If TRUE, the text will be replaced with the default password character.
File: AfxWin.inc
' ========================================================================================
' Gets the token elevation type for the current process.
' Token elevation values describe the relative strength of a given token.
' A full token is a token with all groups and privileges to which the principal
' is authorized. A limited token is one with some groups or privileges removed.
' Requires Windows Vista or superior.
' ========================================================================================
FUNCTION AfxGetTokenElevationType () AS LONG
LOCAL hToken AS DWORD
LOCAL elevationType AS LONG
LOCAL dwSize AS DWORD
IF OpenProcessToken(GetCurrentProcess, %TOKEN_QUERY, hToken) = 0 THEN EXIT FUNCTION
#IF %DEF(%USEPBDECL)
GetTokenInformation(hToken, %TokenElevationType, BYVAL VARPTR(elevationType), 4, dwSize)
#ELSE
GetTokenInformation(hToken, %TokenElevationType, elevationType, 4, dwSize)
#ENDIF
CloseHandle(hToken)
FUNCTION = elevationType
END FUNCTION
' ========================================================================================
File: AfxWin.inc
' ========================================================================================
' Converts point size to DIP (device independent pixel). DIP is defined as 1/96 of an
' inch and a point is 1/72 of an inch.
' ========================================================================================
FUNCTION AfxPointSizeTopDip (BYVAL ptsize AS SINGLE) AS SINGLE
FUNCTION = (ptsize/72) * 96
END FUNCTION
' ========================================================================================
File: AfxSid.inc
' ========================================================================================
' Tests whether the current user is a member of the Administrator's group.
' Caller is NOT expected to be impersonating anyone and is expected to be able to
' open its own process and process token.
' See: http://msdn.microsoft.com/en-us/library/windows/desktop/aa376389%28v=vs.85%29.aspx
' Return Value:
' TRUE - Caller has Administrators local group.
' FALSE - Caller does not have Administrators local group.
' Note: Replacement for the Windows API function IsUserAnAdmin because Microsoft warns
' about the use of this function and advices to call CheckTokenMembership directly.
' ========================================================================================
FUNCTION AfxIsUserAnAdmin () AS LONG
LOCAL IsMember AS LONG
LOCAL NtAuthority AS SID_IDENTIFIER_AUTHORITY
LOCAL AdministratorsGroup AS DWORD
NtAuthority.Value = $SECURITY_NT_AUTHORITY
IF AllocateAndInitializeSid(NtAuthority, 2, %SECURITY_BUILTIN_DOMAIN_RID, _
%DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, AdministratorsGroup) = 0 THEN EXIT FUNCTION
IF CheckTokenMembership(%NULL, BYVAL AdministratorsGroup, IsMember) <> 0 THEN
FUNCTION = IsMember
END IF
FreeSid(BYVAL AdministratorsGroup)
END FUNCTION
' ========================================================================================
File: AfxSid.inc
' ========================================================================================
' Looks up the user name and domain name for the user account associated with the specified
' local process identifier.
' ========================================================================================
FUNCTION AfxGetUserNameAndDomainFromPid (BYVAL pid AS DWORD, BYREF bstrUser AS WSTRING, BYREF bstrDomain AS WSTRING) AS LONG
LOCAL hProcess AS DWORD
LOCAL hToken AS DWORD
LOCAL ptiUser AS TOKEN_USER PTR
LOCAL cbti AS DWORD
LOCAL snu AS LONG ' SID_NAME_USE enumeration
LOCAL wszUser AS WSTRINGZ * 256
LOCAL wszDomain AS WSTRINGZ * %MAX_PATH
' // Open the local process
hProcess = OpenProcess(%PROCESS_ALL_ACCESS, %FALSE, pid)
IF hProcess = %NULL THEN
FUNCTION = GetLastError
EXIT FUNCTION
END IF
' // Get the access token associated with the process
IF ISFALSE OpenProcessToken(hProcess, %TOKEN_QUERY, hToken) THEN
FUNCTION = GetLastError
GOTO LExit
END IF
' // Obtain the size of the user information in the token
IF GetTokenInformation(hToken, %TokenUser, BYVAL %NULL, 0, cbti) <> 0 THEN
FUNCTION = GetLastError
GOTO LExit
END IF
' // Call should have failed due to zero-length buffer
IF GetLastError <> %ERROR_INSUFFICIENT_BUFFER THEN
FUNCTION = GetLastError
GOTO LExit
END IF
' // Allocate buffer for user information in the token
ptiUser = HeapAlloc(GetProcessHeap, %HEAP_GENERATE_EXCEPTIONS, cbti)
IF ptiUser = %NULL THEN
FUNCTION = %E_OUTOFMEMORY
GOTO LExit
END IF
' // Retrieve the user information from the token
IF ISFALSE GetTokenInformation(hToken, %TokenUser, BYVAL ptiUser, cbti, cbti) THEN
FUNCTION = GetLastError
GOTO LExit
END IF
' // Retrieve user name and domain name based on user's SID.
IF ISFALSE LookupAccountSidW(BYVAL %NULL, BYVAL @ptiUser.User.Sid, wszUser, SIZEOF(wszUser), _
wszDomain, SIZEOF(wszDomain), snu) <> 0 THEN
FUNCTION = GetLastError
GOTO LExit
EXIT FUNCTION
END IF
bstrUser = wszUser
bstrDomain = wszDomain
LExit:
' // Free resources
IF hProcess THEN CloseHandle(hProcess)
IF hToken THEN CloseHandle(hToken)
IF ptiUser THEN HeapFree(GetProcessHeap, 0, ptiUser)
END FUNCTION
' ========================================================================================
File: CAfxMp3.inc. Plays MP3 files.
' ########################################################################################
' Microsoft Windows
' File: CAfxMp3.inc
' Contents: MP3 class.
' Copyright (c) 2012 Jose Roca.
' Based on Simple C++ DirectShow MP3 Player Class by Wong Shao Voon, 26 Apr 2010.
' http://www.codeproject.com/Articles/373613/Simple-Cplusplus-DirectShow-MP3-Player-Class
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#INCLUDE THIS ONCE
%CAFXMP3_INC = 1
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "DShow.inc" ' // Director Show
' ########################################################################################
' CAfxMp3 class.
' ########################################################################################
CLASS CAfxMp3
INSTANCE m_pIGraphBuilder AS IGraphBuilder
INSTANCE m_pIMediaControl AS IMediaControl
INSTANCE m_pIMediaEventEx AS IMediaEventEx
INSTANCE m_pIBasicAudio AS IBasicAudio
INSTANCE m_pIMediaSeeking AS IMediaSeeking
INSTANCE m_ready AS LONG
INSTANCE m_duration AS QUAD
INTERFACE IAfxMp3 : INHERIT IAutomation
' =====================================================================================
' Cleans resources
' =====================================================================================
METHOD Cleanup
m_pIGraphBuilder = NOTHING
m_pIMediaControl = NOTHING
m_pIMediaEventEx = NOTHING
m_pIBasicAudio = NOTHING
m_pIMediaSeeking = NOTHING
END METHOD
' =====================================================================================
' =====================================================================================
' Builds a filter graph that renders the specified file.
' Return Value = %TRUE or %FALSE.
' OBJRESULT
' %S_OK = Success.
' %VFW_S_AUDIO_NOT_RENDERED = Partial success; the audio was not rendered.
' %VFW_S_DUPLICATE_NAME = Success; the Filter Graph Manager modified the filter name to avoid duplication.
' %VFW_S_PARTIAL_RENDER = Some of the streams in this movie are in an unsupported format.
' %VFW_S_VIDEO_NOT_RENDERED = Partial success; some of the streams in this movie are in an unsupported format.
' %E_ABORT = Operation aborted.
' %E_FAIL = Failure.
' %E_INVALIDARG = Argument is invalid.
' %E_OUTOFMEMORY = Insufficient memory.
' %E_POINTER = NULL pointer argument.
' %VFW_E_CANNOT_CONNECT = No combination of intermediate filters could be found to make the connection.
' %VFW_E_CANNOT_LOAD_SOURCE_FILTER = The source filter for this file could not be loaded.
' %VFW_E_CANNOT_RENDER = No combination of filters could be found to render the stream.
' %VFW_E_INVALID_FILE_FORMAT = The file format is invalid.
' %VFW_E_NOT_FOUND = An object or name was not found.
' %VFW_E_UNKNOWN_FILE_TYPE = The media type of this file is not recognized.
' 5VFW_E_UNSUPPORTED_STREAM = Cannot play back the file: the format is not supported.
' =====================================================================================
METHOD Load (BYVAL bstrFile AS WSTRING) AS LONG
LOCAL hr AS LONG
m_ready = %FALSE
ME.Cleanup
m_pIGraphBuilder = NEWCOM CLSID $CLSID_FilterGraph
IF ISNOTHING(m_pIGraphBuilder) THEN EXIT METHOD
m_pIMediaControl = m_pIGraphBuilder
m_pIMediaEventEx = m_pIGraphBuilder
m_pIBasicAudio = m_pIGraphBuilder
m_pIMediaSeeking = m_pIGraphBuilder
hr = m_pIGraphBuilder.RenderFile(BYCOPY bstrFile)
IF SUCCEEDED(hr) THEN
m_ready = %TRUE
IF ISOBJECT(m_pIMediaSeeking) THEN
m_pIMediaSeeking.SetTimeFormat($TIME_FORMAT_MEDIA_TIME) ' // Reference time (100-nanosecond units).
m_pIMediaSeeking.GetDuration(m_duration) ' // Returns 10,000,000 for a second.
END IF
END IF
METHOD = m_ready
IF hr THEN METHOD OBJRESULT = hr
END METHOD
' =====================================================================================
' =====================================================================================
' Runs all the filters in the filter graph.
' Return Value = %TRUE or %FALSE.
' OBJRESULT
' %S_FALSE The graph is preparing to run, but some filters have not completed the transition to a running state.
' %S_OK = All filters in the graph completed the transition to a running state.
' =====================================================================================
METHOD Run () AS LONG
IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
m_pIMediaControl.Run
IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
END IF
END METHOD
' =====================================================================================
' =====================================================================================
' Pauses all the filters in the filter graph.
' Return Value = %TRUE or %FALSE.
' OBJRESULT
' %S_FALSE The graph paused successfully, but some filters have not completed the state transition.
' %S_OK = All filters in the graph completed the transition to a paused state.
' =====================================================================================
METHOD Pause () AS LONG
LOCAL hr AS LONG
IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
m_pIMediaControl.Pause
IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
END IF
END METHOD
' =====================================================================================
' =====================================================================================
' Stops all the filters in the filter graph.
' Return Value = %TRUE or %FALSE.
' OBJRESUT = Returns S_OK if successful, or an HRESULT value that indicates the cause of the error.
' =====================================================================================
METHOD Stop () AS LONG
LOCAL hr AS LONG
IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
m_pIMediaControl.Stop
IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
END IF
END METHOD
' =====================================================================================
' =====================================================================================
' Waits for the filter graph to render all available data.
' Parameters:
' msTimeout
' [in] Duration of the time-out, in milliseconds. Pass zero to return immediately.
' To block indefinitely, pass INFINITE.
' EvCode
' [out] Event that terminated the wait. This value can be one of the following:
' %EC_COMPLETE = Operation completed.
' %EC_ERRORABORT = Error. Playback cannot continue.
' %EC_USERABORT = User terminated the operation.
' Zero (0) = Operation has not completed.
' Return Value = %TRUE or %FALSE.
' OBJRESULT
' %S_OK = Success.
' %E_ABORT = Time-out expired.
' %VFW_E_WRONG_STATE = The filter graph is not running.
' Remarks
' This method blocks until the time-out expires, or one of the following events occurs:
' %EC_COMPLETE
' %EC_ERRORABORT
' %EC_USERABORT
' During the wait, the method discards all other event notifications.
' If the return value is S_OK, the pEvCode parameter receives the event code that ended
' the wait. When the method returns, the filter graph is still running. The application
' can pause or stop the graph, as appropriate.
' =====================================================================================
METHOD WaitForCompletion (BYVAL msTimeout AS LONG, BYREF EvCode AS LONG) AS LONG
LOCAL hr AS LONG
IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaEventEx) THEN
m_pIMediaEventEx.WaitForcompletion(msTimeout, EvCode)
IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
END IF
END METHOD
' =====================================================================================
' =====================================================================================
' Retrieves the volume (amplitude) of the audio signal.
' Return Value = The volume. Divide by 100 to get equivalent decibel value.
' For example, â€"10,000 is â€"100 dB.
' OBJRESULT
' %E_NOTIMPL = The filter graph does not contain an audio renderer filter.
' (Possibly the source does not contain an audio stream.)
' %S_OK = Success.
' =====================================================================================
PROPERTY GET Volume () AS LONG
IF ISTRUE m_ready AND ISOBJECT(m_pIBasicAudio) THEN
PROPERTY = m_pIBasicAudio.Volume
IF ISFALSE OBJRESULT THEN PROPERTY = %TRUE ELSE PROPERTY OBJRESULT = OBJRESULT
END IF
END PROPERTY
' =====================================================================================
' =====================================================================================
' Sets the volume (amplitude) of the audio signal.
' OBJRESULT
' %E_FAIL = The underlying audio device returned an error.
' %E_INVALIDARG = The value of lVolume is invalid.
' %E_NOTIMPL = The filter graph does not contain an audio renderer filter.
' (Possibly the source does not contain an audio stream.)
' %S_OK = Success.
' =====================================================================================
PROPERTY SET Volume (BYVAL nVol AS LONG)
IF ISTRUE m_ready AND ISOBJECT(m_pIBasicAudio) THEN
m_pIBasicAudio.Volume = nVol
IF OBJRESULT THEN PROPERTY OBJRESULT = OBJRESULT
END IF
END PROPERTY
' =====================================================================================
' =====================================================================================
' Gets the duration of the stream, in 100-nanosecond units.
' Returns 10,000,000 for a second.
' =====================================================================================
PROPERTY GET Duration () AS QUAD
PROPERTY = m_duration
END PROPERTY
' =====================================================================================
' =====================================================================================
' Gets the current position, relative to the total duration of the stream.
' =====================================================================================
PROPERTY GET CurrentPosition () AS QUAD
LOCAL hr AS LONG
LOCAL curPos AS QUAD
IF ISTRUE m_ready AND ISOBJECT(m_pIMediaSeeking) THEN
m_pIMediaSeeking.GetCurrentPosition(curPos)
IF SUCCEEDED(hr) THEN PROPERTY = curPos ELSE PROPERTY OBJRESULT = hr
END IF
END PROPERTY
' =====================================================================================
' =====================================================================================
' Sets the current position and the stop position.
' Return Value = %TRUE or %FALSE.
' Parameters:
' pCurrent = [in, out] Pointer to a variable that specifies the current position, in units of the current time format.
' pStop = [in, out] Pointer to a variable that specifies the stop time, in units of the current time format.
' bAbsolutePositioning = %TRUE or %FALSE. IF %TRUE, the specified position is absolute.
' IF %FLASE, the specified position is relative.
' OBJRESULT
' %S_FALSE = No position change. (Both flags specify no seeking.)
' %S_OK = Success.
' %E_INVALIDARG = Invalid argument.
' %E_NOTIMPL = Method is not supported.
' %E_POINTER = NULL pointer argument.
' =====================================================================================
METHOD SetPositions (BYREF pCurrent AS QUAD, BYREF pStop AS QUAD, BYVAL bAbsolutePositioning AS LONG) AS LONG
LOCAL hr AS LONG
LOCAL dwFlags AS DWORD
IF ISTRUE m_ready AND ISOBJECT(m_pIMediaSeeking) THEN
IF bAbsolutePositioning THEN
dwFlags = %AM_SEEKING_AbsolutePositioning OR %AM_SEEKING_SeekToKeyFrame
ELSE
dwFlags = %AM_SEEKING_RelativePositioning OR %AM_SEEKING_SeekToKeyFrame
END IF
hr = m_pIMediaSeeking.SetPositions(pCurrent, dwFlags, pStop, dwFlags)
IF SUCCEEDED(hr) THEN METHOD = %TRUE ELSE METHOD OBJRESULT = hr
END IF
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ########################################################################################
Usage example:
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "CAfxMp3.inc"
FUNCTION PBMAIN () AS LONG
' // Create an instance of the class
LOCAL pAfxMp3 AS IAfxMp3
pAfxMp3 = CLASS "CAfxMp3"
IF ISNOTHING(pAfxMp3) THEN EXIT FUNCTION
TRY
' // Load the MP3 file
pAfxMp3.Load(EXE.PATH$ & "Kalimba.mp3") ' --> change me
' // Play it
pAfxMp3.Run
' // ... after some time, stop it
WAITKEY$
pAfxMp3.Stop
CATCH
? HEX$(OBJRESULT)
WAITKEY$
END TRY
END FUNCTION
File: GdipUtils.inc.
Displays the printer dialog and prints the specified image at its real size or stretched to the paper size. Allows printing of multiframe .tif files.
' ========================================================================================
' Displays the printer dialog and prints the specified image.
' Parameters:
' - wszFileName = The name of the image file to print.
' - bStretch = %TRUE or FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Deafault value = %InterpolationModeHighQualityBicubic.
' %InterpolationModeLowQuality = 1
' %InterpolationModeHighQuality = 2
' %InterpolationModeBilinear = 3
' %InterpolationModeBicubic = 4
' %InterpolationModeNearestNeighbor = 5
' %InterpolationModeHighQualityBilinear = 6
' %InterpolationModeHighQualityBicubic = 7
' Return Value: Return %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintImageDlg(BYREF wszFileName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG
' // Display te print dialog
LOCAL hr AS LONG
LOCAL ppd AS PRINTDLGAPIW
ppd.lStructSize = SIZEOF(PRINTDLGAPIW)
ppd.flags = %PD_RETURNDC OR %PD_ALLPAGES OR %PD_NOPAGENUMS OR %PD_NOSELECTION
hr = PrintDlgW(ppd)
IF hr <> %PD_RESULT_PRINT THEN EXIT FUNCTION
LOCAL token AS DWORD
LOCAL StartupInput AS GdiplusStartupInput
' // Initialize GDI+
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF hr THEN GOTO LExit
LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
' // Create a graphics object from the printer DC
hStatus = GdipCreateFromHDC(ppd.hDc, pGraphics)
IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
' // Create a Bitmap object from a JPEG file.
LOCAL pBitmap AS DWORD
hStatus = GdipCreateBitmapFromFile(wszFileName, pBitmap)
IF hStatus <> %S_OK OR pBitmap = 0 THEN GOTO LExit
' // Get the width and height of the bitmap
LOCAL nWidth, nHeight AS DWORD
GdipGetImageWidth(pBitmap, nWidth)
GdipGetImageHeight(pBitmap, nHeight)
' // Stretching
LOCAL cx, cy AS SINGLE
IF bStretch THEN
IF nStretchMode THEN
' // Set the interpolation mode
IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
GdipSetInterpolationMode(pGraphics, nStretchMode)
END IF
' // Get the DPIs of the printer
LOCAL dpiX, dpiY AS SINGLE
GdipGetDpiX(pGraphics, dpiX)
GdipGetDpiY(pGraphics, dpiY)
' // Calculate the width and height according to the DPI of the printer
cx = GetDeviceCaps(ppd.hDc, %HORZRES) / (dpiX / 100)
cy = GetDeviceCaps(ppd.hDc, %VERTRES) / (dpiY / 100)
END IF
' // How many frame dimensions does the Image object have?
LOCAL nCount AS LONG
hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
IF nCount THEN
DIM dimensionIDs(0) AS GUID
LOCAL frameCount AS DWORD
' // Get the list of frame dimensions from the Image object.
REDIM dimensionIDs(nCount - 1)
hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
' // Display the GUID of the first (and only) frame dimension.
' // Get the number of frames in the first dimension.
hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
IF frameCount = 0 THEN GOTO LExit
END IF
' // Frame dimension page
LOCAL pageGuid AS GUID
pageGuid = $FrameDimensionPage
' // Print the bitmap
LOCAL di AS DOCINFOW
di.cbSize = SIZEOF(DOCINFOW)
di.lpszDocName = VARPTR(wszFileName)
hr = StartDocW(ppd.hDc, di)
IF hr <= 0 THEN GOTO LExit
LOCAL i, x AS LONG
FOR i = 1 TO ppd.nCopies
FOR x = 0 TO frameCount - 1
IF StartPage(ppd.hDc) THEN
' // Select the frame
hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
' // Draw the image
IF bStretch THEN
hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
ELSE
hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
END IF
EndPage(ppd.hDc)
END IF
NEXT
NEXT
EndDoc(ppd.hDc)
LExit:
' // Cleanup
IF ppd.hDc THEN DeleteDC ppd.hDc
IF pBitmap THEN GdipDisposeImage(pBitmap)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)
' // Shutdown GDI+
IF token THEN GdiplusShutdown token
END FUNCTION
' ========================================================================================
File: GdipUtils.inc
This one prints the image directly to the default printer.
' ========================================================================================
' Prints the specified image using the current default printer and printer settings.
' Parameters:
' - wszFileName = The name of the image file to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
' %InterpolationModeLowQuality = 1
' %InterpolationModeHighQuality = 2
' %InterpolationModeBilinear = 3
' %InterpolationModeBicubic = 4
' %InterpolationModeNearestNeighbor = 5
' %InterpolationModeHighQualityBilinear = 6
' %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintImage (BYREF wszFileName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG
' // Get the name of the default printer
LOCAL wszPrinterName AS WSTRINGZ * %MAX_PATH
GetProfileStringW("WINDOWS", "DEVICE", "", wszPrinterName, SIZEOF(wszPrinterName))
wszPrinterName = PARSE$(wszPrinterName, 1)
IF wszPrinterName = "" THEN EXIT FUNCTION
' // Open the printer
LOCAL hPrinter AS DWORD
IF OpenPrinterW(wszPrinterName, hPrinter, BYVAL %NULL) = 0 THEN EXIT FUNCTION
' // Allocate a buffer of the correct size
LOCAL dwNeeded AS DWORD
LOCAL bufferDoc AS STRING
dwNeeded = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL %NULL, BYVAL %NULL, 0)
bufferDoc = SPACE$(dwNeeded)
' // Retrieve the printer configuration data
LOCAL nRet AS LONG
nRet = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL STRPTR(bufferDoc), BYVAL %NULL, %DM_OUT_BUFFER)
IF nRet <> %IDOK THEN GOTO LExit
' // Cast it to a DEVMODEW structure
LOCAL pDevMode AS DEVMODEW PTR
pDevMode = STRPTR(bufferDoc)
' // Create a device context for the printer
LOCAL hdc AS DWORD
hdc = CreateDCW(wszPrinterName, wszPrinterName, BYVAL %NULL, BYVAL pDevMode)
IF hdc = %NULL THEN GOTO LExit
' // Initialize GDI+
LOCAL hr AS LONG
LOCAL token AS DWORD
LOCAL StartupInput AS GdiplusStartupInput
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF hr THEN GOTO LExit
' // Create a graphics object from the printer DC
LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
hStatus = GdipCreateFromHDC(hdc, pGraphics)
IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
' // Create a Bitmap object from a file.
LOCAL pBitmap AS DWORD
hStatus = GdipCreateBitmapFromFile(wszFileName, pBitmap)
IF hStatus <> %S_OK OR pBitmap = 0 THEN GOTO LExit
' // Get the width and height of the bitmap
LOCAL nWidth, nHeight AS DWORD
GdipGetImageWidth(pBitmap, nWidth)
GdipGetImageHeight(pBitmap, nHeight)
' // Stretching
LOCAL cx, cy AS SINGLE
IF bStretch THEN
IF nStretchMode THEN
' // Set the interpolation mode
IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
GdipSetInterpolationMode(pGraphics, nStretchMode)
END IF
' // Get the DPIs of the printer
LOCAL dpiX, dpiY AS SINGLE
GdipGetDpiX(pGraphics, dpiX)
GdipGetDpiY(pGraphics, dpiY)
' // Calculate the width and height according to the DPIs of the printer
cx = GetDeviceCaps(hdc, %HORZRES) / (dpiX / 100)
cy = GetDeviceCaps(hdc, %VERTRES) / (dpiY / 100)
END IF
' // How many frame dimensions does the Image object have?
LOCAL nCount AS LONG
hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
IF nCount THEN
DIM dimensionIDs(0) AS GUID
LOCAL frameCount AS DWORD
' // Get the list of frame dimensions from the Image object.
REDIM dimensionIDs(nCount - 1)
hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
' // Get the number of frames in the first (and only) frame dimension.
hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
IF frameCount = 0 THEN GOTO LExit
END IF
' // Frame dimension page
LOCAL pageGuid AS GUID
pageGuid = $FrameDimensionPage
' // Print the bitmap
LOCAL di AS DOCINFOW
di.cbSize = SIZEOF(DOCINFOW)
di.lpszDocName = VARPTR(wszFileName)
hr = StartDocW(hdc, di)
IF hr <= 0 THEN GOTO LExit
LOCAL i, x AS LONG
FOR i = 1 TO @pDevMode.dmCopies
FOR x = 0 TO frameCount - 1
IF StartPage(hdc) THEN
' // Select the frame
hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
' // Draw the image
IF bStretch THEN
hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
ELSE
hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
END IF
EndPage(hdc)
END IF
NEXT
NEXT
EndDoc(hdc)
LExit:
' // Finished with the printer
IF hPrinter THEN ClosePrinter(hPrinter)
' // Cleanup
IF hdc THEN DeleteDC(hdc)
IF pBitmap THEN GdipDisposeImage(pBitmap)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)
' // Shutdown GDI+
IF token THEN GdiplusShutdown token
END FUNCTION
' ========================================================================================
File: GdipUtils.inc
' ========================================================================================
' Displays the printer dialog and prints the specified resource image.
' Parameters:
' - hInstance = The instance handle.
' - wszImageName = The name of the image to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
' %InterpolationModeLowQuality = 1
' %InterpolationModeHighQuality = 2
' %InterpolationModeBilinear = 3
' %InterpolationModeBicubic = 4
' %InterpolationModeNearestNeighbor = 5
' %InterpolationModeHighQualityBilinear = 6
' %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintResourceImageDlg(BYVAL hInstance AS DWORD, BYREF wszImageName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG
IF hInstance = 0 THEN EXIT FUNCTION
' // Display te print dialog
LOCAL hr AS LONG
LOCAL ppd AS PRINTDLGAPIW
ppd.lStructSize = SIZEOF(PRINTDLGAPIW)
ppd.flags = %PD_RETURNDC OR %PD_ALLPAGES OR %PD_NOPAGENUMS OR %PD_NOSELECTION OR %PD_DISABLEPRINTTOFILE
hr = PrintDlgW(ppd)
IF hr <> %PD_RESULT_PRINT THEN EXIT FUNCTION
' // Initialize GDI+
LOCAL token AS DWORD
LOCAL StartupInput AS GdiplusStartupInput
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF hr THEN GOTO LExit
' // Create a graphics object from the printer DC
LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
hStatus = GdipCreateFromHDC(ppd.hDc, pGraphics)
IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
' // Create a bitmap from the resource image
LOCAL hResource AS DWORD ' // Resource handle
LOCAL pResourceData AS DWORD ' // Pointer to the resoruce data
LOCAL hGlobal AS DWORD ' // Global memory handle
LOCAL pGlobalBuffer AS DWORD ' // Pointer to global memory buffer
LOCAL pImageStream AS IStream ' // IStream interface pointer
LOCAL pBitmap AS DWORD ' // Bitmap object
LOCAL imageSize AS DWORD ' // Image size
LOCAL wID AS WORD
LOCAL dwID AS DWORD
' // Find the resource and lock it
IF LEFT$(wszImageName, 1) = "#" THEN
wID = VAL(MID$(wszImageName, 2))
dwID = MAK(DWORD, wID, 0)
hResource = FindResourceW(hInstance, BYVAL dwID, BYVAL %RT_RCDATA)
ELSE
hResource = FindResourceW(hInstance, wszImageName, BYVAL %RT_RCDATA)
END IF
IF hResource = %NULL THEN GOTO LExit
imageSize = SizeofResource(hInstance, hResource)
IF imageSize = 0 THEN GOTO LExit
pResourceData = LockResource(LoadResource(hInstance, hResource))
IF pResourceData = %NULL THEN GOTO LExit
' // Allocate memory to hold the image
hGlobal = GlobalAlloc(%GMEM_MOVEABLE, imageSize)
IF hGlobal THEN
' // Lock the memory
pGlobalBuffer = GlobalLock(hGlobal)
IF pGlobalBuffer THEN
' // Copy the image from the resource file to global memory
CopyMemory pGlobalBuffer, pResourceData, imageSize
' // Create an stream in global memory
IF CreateStreamOnHGlobal(hGlobal, %FALSE, pImageStream) = %S_OK THEN
' // Create a bitmap from the data contained in the stream
hStatus = GdipCreateBitmapFromStream(pImageStream, pBitmap)
pImageStream = NOTHING
END IF
END IF
END IF
IF pBitmap = 0 THEN GOTO LExit
' // Get the width and height of the bitmap
LOCAL nWidth, nHeight AS DWORD
GdipGetImageWidth(pBitmap, nWidth)
GdipGetImageHeight(pBitmap, nHeight)
' // Stretching
LOCAL cx, cy AS SINGLE
IF bStretch THEN
IF nStretchMode THEN
' // Set the interpolation mode
IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
GdipSetInterpolationMode(pGraphics, nStretchMode)
END IF
' // Get the DPIs of the printer
LOCAL dpiX, dpiY AS SINGLE
GdipGetDpiX(pGraphics, dpiX)
GdipGetDpiY(pGraphics, dpiY)
' // Calculate the width and height according to the DPIs of the printer
cx = GetDeviceCaps(ppd.hDc, %HORZRES) / (dpiX / 100)
cy = GetDeviceCaps(ppd.hDc, %VERTRES) / (dpiY / 100)
END IF
' // How many frame dimensions does the Image object have?
LOCAL nCount AS LONG
hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
IF nCount THEN
DIM dimensionIDs(0) AS GUID
LOCAL frameCount AS DWORD
' // Get the list of frame dimensions from the Image object.
REDIM dimensionIDs(nCount - 1)
hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
' // Get the number of frames in the first (and only) frame dimension.
hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
IF frameCount = 0 THEN GOTO LExit
END IF
' // Frame dimension page
LOCAL pageGuid AS GUID
pageGuid = $FrameDimensionPage
' // Print the bitmap
LOCAL di AS DOCINFOW
di.cbSize = SIZEOF(DOCINFOW)
di.lpszDocName = VARPTR(wszImageName)
hr = StartDocW(ppd.hDc, di)
IF hr <= 0 THEN GOTO LExit
LOCAL i, x AS LONG
FOR i = 1 TO ppd.nCopies
FOR x = 0 TO frameCount - 1
IF StartPage(ppd.hDc) THEN
' // Select the frame
hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
' // Draw the image
IF bStretch THEN
hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
ELSE
hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
END IF
EndPage(ppd.hDc)
END IF
NEXT
NEXT
EndDoc(ppd.hDc)
LExit:
' // Cleanup
IF ppd.hDc THEN DeleteDC(ppd.hDc)
IF pBitmap THEN GdipDisposeImage(pBitmap)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)
' // Unlock and free the global memory
IF pGlobalBuffer THEN GlobalUnlock(pGlobalBuffer)
IF hGlobal THEN GlobalFree(hGlobal)
' // Shutdown GDI+
IF token THEN GdiplusShutdown token
END FUNCTION
' ========================================================================================
File: GdipUtils.inc
' ========================================================================================
' Prints the specified resource image using the current default printer and printer settings.
' Parameters:
' - hInstance = The instance handle.
' - wszImageName = The name of the image to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
' %InterpolationModeLowQuality = 1
' %InterpolationModeHighQuality = 2
' %InterpolationModeBilinear = 3
' %InterpolationModeBicubic = 4
' %InterpolationModeNearestNeighbor = 5
' %InterpolationModeHighQualityBilinear = 6
' %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintResourceImage(BYVAL hInstance AS DWORD, BYREF wszImageName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG
' // Get the name of the default printer
LOCAL wszPrinterName AS WSTRINGZ * %MAX_PATH
GetProfileStringW("WINDOWS", "DEVICE", "", wszPrinterName, SIZEOF(wszPrinterName))
wszPrinterName = PARSE$(wszPrinterName, 1)
IF wszPrinterName = "" THEN EXIT FUNCTION
' // Open the printer
LOCAL hPrinter AS DWORD
IF OpenPrinterW(wszPrinterName, hPrinter, BYVAL %NULL) = 0 THEN EXIT FUNCTION
' // Allocate a buffer of the correct size
LOCAL dwNeeded AS DWORD
LOCAL bufferDoc AS STRING
dwNeeded = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL %NULL, BYVAL %NULL, 0)
bufferDoc = SPACE$(dwNeeded)
' // Retrieve the printer configuration data
LOCAL nRet AS LONG
nRet = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL STRPTR(bufferDoc), BYVAL %NULL, %DM_OUT_BUFFER)
IF nRet <> %IDOK THEN GOTO LExit
' // Cast it to a DEVMODEW structure
LOCAL pDevMode AS DEVMODEW PTR
pDevMode = STRPTR(bufferDoc)
' // Create a device context for the printer
LOCAL hdc AS DWORD
hdc = CreateDCW(wszPrinterName, wszPrinterName, BYVAL %NULL, BYVAL pDevMode)
IF hdc = %NULL THEN GOTO LExit
' // Initialize GDI+
LOCAL hr AS LONG
LOCAL token AS DWORD
LOCAL StartupInput AS GdiplusStartupInput
StartupInput.GdiplusVersion = 1
hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF hr THEN GOTO LExit
' // Create a graphics object from the printer DC
LOCAL hStatus AS LONG
LOCAL pGraphics AS DWORD
hStatus = GdipCreateFromHDC(hdc, pGraphics)
IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
' // Create a bitmap from the resource image
LOCAL hResource AS DWORD ' // Resource handle
LOCAL pResourceData AS DWORD ' // Pointer to the resoruce data
LOCAL hGlobal AS DWORD ' // Global memory handle
LOCAL pGlobalBuffer AS DWORD ' // Pointer to global memory buffer
LOCAL pImageStream AS IStream ' // IStream interface pointer
LOCAL pBitmap AS DWORD ' // Bitmap object
LOCAL imageSize AS DWORD ' // Image size
LOCAL wID AS WORD
LOCAL dwID AS DWORD
' // Find the resource and lock it
IF LEFT$(wszImageName, 1) = "#" THEN
wID = VAL(MID$(wszImageName, 2))
dwID = MAK(DWORD, wID, 0)
hResource = FindResourceW(hInstance, BYVAL dwID, BYVAL %RT_RCDATA)
ELSE
hResource = FindResourceW(hInstance, wszImageName, BYVAL %RT_RCDATA)
END IF
IF hResource = %NULL THEN GOTO LExit
imageSize = SizeofResource(hInstance, hResource)
IF imageSize = 0 THEN GOTO LExit
pResourceData = LockResource(LoadResource(hInstance, hResource))
IF pResourceData = %NULL THEN GOTO LExit
' // Allocate memory to hold the image
hGlobal = GlobalAlloc(%GMEM_MOVEABLE, imageSize)
IF hGlobal THEN
' // Lock the memory
pGlobalBuffer = GlobalLock(hGlobal)
IF pGlobalBuffer THEN
' // Copy the image from the resource file to global memory
CopyMemory pGlobalBuffer, pResourceData, imageSize
' // Create an stream in global memory
IF CreateStreamOnHGlobal(hGlobal, %FALSE, pImageStream) = %S_OK THEN
' // Create a bitmap from the data contained in the stream
hStatus = GdipCreateBitmapFromStream(pImageStream, pBitmap)
pImageStream = NOTHING
END IF
END IF
END IF
IF pBitmap = 0 THEN GOTO LExit
' // Get the width and height of the bitmap
LOCAL nWidth, nHeight AS DWORD
GdipGetImageWidth(pBitmap, nWidth)
GdipGetImageHeight(pBitmap, nHeight)
' // Stretching
LOCAL cx, cy AS SINGLE
IF bStretch THEN
IF nStretchMode THEN
' // Set the interpolation mode
IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
GdipSetInterpolationMode(pGraphics, nStretchMode)
END IF
' // Get the DPIs of the printer
LOCAL dpiX, dpiY AS SINGLE
GdipGetDpiX(pGraphics, dpiX)
GdipGetDpiY(pGraphics, dpiY)
' // Calculate the width and height according to the DPIs of the printer
cx = GetDeviceCaps(hdc, %HORZRES) / (dpiX / 100)
cy = GetDeviceCaps(hdc, %VERTRES) / (dpiY / 100)
END IF
' // How many frame dimensions does the Image object have?
LOCAL nCount AS LONG
hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
IF nCount THEN
DIM dimensionIDs(0) AS GUID
LOCAL frameCount AS DWORD
' // Get the list of frame dimensions from the Image object.
REDIM dimensionIDs(nCount - 1)
hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
' // Get the number of frames in the first (and only) frame dimension.
hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
IF frameCount = 0 THEN GOTO LExit
END IF
' // Frame dimension page
LOCAL pageGuid AS GUID
pageGuid = $FrameDimensionPage
' // Print the bitmap
LOCAL di AS DOCINFOW
di.cbSize = SIZEOF(DOCINFOW)
di.lpszDocName = VARPTR(wszImageName)
hr = StartDocW(hdc, di)
IF hr <= 0 THEN GOTO LExit
LOCAL i, x AS LONG
FOR i = 1 TO @pDevMode.dmCopies
FOR x = 0 TO frameCount - 1
IF StartPage(hdc) THEN
' // Select the frame
hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
' // Draw the image
IF bStretch THEN
hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
ELSE
hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
END IF
EndPage(hdc)
END IF
NEXT
NEXT
EndDoc(hdc)
LExit:
' // Finished with the printer
IF hPrinter THEN ClosePrinter(hPrinter)
' // Cleanup
IF hdc THEN DeleteDC(hdc)
IF pBitmap THEN GdipDisposeImage(pBitmap)
IF pGraphics THEN GdipDeleteGraphics(pGraphics)
' // Unlock and free the global memory
IF pGlobalBuffer THEN GlobalUnlock(pGlobalBuffer)
IF hGlobal THEN GlobalFree(hGlobal)
' // Shutdown GDI+
IF token THEN GdiplusShutdown token
END FUNCTION
' ========================================================================================
File: AfxWin.inc
' ========================================================================================
' Checks if the specified URL exists.
' Parameters:
' - bstrUrl = URL to check.
' - vTimeout = Optional. Number of seconds to wait. The default value is -1 (infinite).
' Return value: TRUE or FALSE
' To retrieve extended error information, call GetLastError. The error code is returned as
' an HRESULT code to allow the use of OBJRESULT$ to get a localized description of it.
' ========================================================================================
FUNCTION AfxUrlExists (BYVAL bstrUrl AS WSTRING, OPTIONAL BYVAL vTimeout AS VARIANT) AS LONG
LOCAL pWHttp AS IWinHttpRequest
LOCAL iSucceeded AS INTEGER
' // Creates an instance of the HTTP service
pWHttp = NEWCOM "WinHttp.WinHttpRequest.5.1"
IF ISNOTHING(pWHttp) THEN
SetLastError %E_NOINTERFACE
EXIT FUNCTION
END IF
TRY
' // Opens an HTTP connection to an HTTP resource
pWHttp.Open "GET", bstrUrl
' // Sends an HTTP request to the HTTP server
pWHttp.Send
' // Wait for response
iSucceeded = pWHttp.WaitForResponse(vTimeout)
IF iSucceeded THEN
' // If it exists, pWHttp.Status returns a value of 200 and pWHttp.StatusText a value of "OK"
' // If it does not exist, pWHttp.Status returns a value of 404 and pWHttp.StatusText a value of "Not Found"
IF pWHttp.Status = 200 THEN FUNCTION = %TRUE
ELSE
SetLastError HRESULT_FROM_WIN32(%ERROR_TIMEOUT)
END IF
CATCH
SetLastError OBJRESULT
END TRY
END FUNCTION
' ========================================================================================
File: AfxWin.inc
' ========================================================================================
' Retrieves the version of the specified system DLL.
' ========================================================================================
FUNCTION AfxGetDllVersion (BYVAL bstrDllName AS WSTRING) AS CURRENCYX
LOCAL pvsffi AS VS_FIXEDFILEINFO PTR
LOCAL pVerInfo AS DWORD
LOCAL dwHandle AS DWORD
LOCAL dwVersion AS DWORD
LOCAL cbLen AS DWORD
LOCAL wMajor AS WORD
LOCAL wMinor AS WORD
cbLen = GetFileVersionInfoSize(BYCOPY bstrDllName, dwHandle)
IF cbLen THEN
pVerInfo = HeapAlloc(GetProcessHeap, %HEAP_ZERO_MEMORY, cbLen)
IF pVerInfo THEN
IF GetFileVersionInfo(BYCOPY bstrDllName, dwHandle, cbLen, BYVAL pVerInfo) THEN
IF VerQueryValue(BYVAL pVerInfo, "\", BYVAL VARPTR(pvsffi), cbLen) THEN
wMajor = HI(WORD, @pvsffi.dwFileVersionMS)
wMinor = LO(WORD, @pvsffi.dwFileVersionMS)
END IF
END IF
HeapFree GetProcessHeap, 0, pVerInfo
END IF
END IF
FUNCTION = wMajor + wMinor / 100
END FUNCTION
' ========================================================================================
File: AfxWin.inc
' ========================================================================================
' Retrieves the path of the specified system DLL.
' ========================================================================================
FUNCTION AfxGetDllPath (BYVAL bstrDllName AS WSTRING) AS WSTRING
LOCAL hLib AS DWORD
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
hLib = LoadLibraryW(BYCOPY bstrDllName)
IF hLib THEN
GetModuleFileNameW(hLib, wszPath, SIZEOF(wszPath))
FreeLibrary hLib
END IF
FUNCTION = wszPath
END FUNCTION
' ========================================================================================
' =====================================================================================
' Unscales an horizontal coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
FUNCTION AfxUnScaleX (BYVAL cx AS SINGLE) AS SINGLE
LOCAL hDC AS DWORD
hDC = GetDC(%NULL)
FUNCTION = cx / (GetDeviceCaps(hDC, %LOGPIXELSX) / 96)
ReleaseDC %NULL, hDC
END FUNCTION
' =====================================================================================
' =====================================================================================
' Unscales a vertical coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
FUNCTION AfxUnScaleY (BYVAL cy AS SINGLE) AS SINGLE
LOCAL hDC AS DWORD
hDC = GetDC(%NULL)
FUNCTION = cy / (GetDeviceCaps(hDC, %LOGPIXELSY) / 96)
ReleaseDC %NULL, hDC
END FUNCTION
' =====================================================================================
File: GdipUtils.inc.
' ========================================================================================
' Returns the version of GdiPlus.dll
' ========================================================================================
FUNCTION GdiPlusDllVersion () AS CURRENCYX
LOCAL pvsffi AS VS_FIXEDFILEINFO PTR
LOCAL pVerInfo AS DWORD
LOCAL dwHandle AS DWORD
LOCAL dwVersion AS DWORD
LOCAL cbLen AS DWORD
LOCAL wMajor AS WORD
LOCAL wMinor AS WORD
cbLen = GetFileVersionInfoSize("GDIPLUS.DLL", dwHandle)
IF cbLen THEN
pVerInfo = HeapAlloc(GetProcessHeap, %HEAP_ZERO_MEMORY, cbLen)
IF pVerInfo THEN
IF GetFileVersionInfo("GDIPLUS.DLL", dwHandle, cbLen, BYVAL pVerInfo) THEN
IF VerQueryValue(BYVAL pVerInfo, "\", BYVAL VARPTR(pvsffi), cbLen) THEN
wMajor = HI(WORD, @pvsffi.dwFileVersionMS)
wMinor = LO(WORD, @pvsffi.dwFileVersionMS)
END IF
END IF
HeapFree GetProcessHeap, 0, pVerInfo
END IF
END IF
FUNCTION = wMajor + wMinor / 100
END FUNCTION
' ========================================================================================
File: AfxWin.inc
' ========================================================================================
' Retrieves the Internet Explorer version (major.minor).
' ========================================================================================
FUNCTION AfxGetInternetExplorerVersion () AS CURRENCY
LOCAL hKey AS DWORD
LOCAL wszBuff AS WSTRINGZ * 1024
IF RegOpenKeyExW(%HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer", 0, _
%KEY_QUERY_VALUE, hKey) <> %ERROR_SUCCESS THEN EXIT FUNCTION
RegQueryValueExW hKey, "Version", 0, 0, wszBuff, SIZEOF(wszBuff)
RegCloseKey hKey
FUNCTION = VAL(wszBuff)
END FUNCTION
' ========================================================================================
File: AfxPath.inc
' ========================================================================================
' Retrieves the path of the default browser.
' ========================================================================================
FUNCTION AfxGetDefaultBrowserPath () AS WSTRING
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
IF SUCCEEDED(AssocQueryStringW(0, %ASSOCSTR_EXECUTABLE, "http", "open", wszPath, SIZEOF(wszPath))) THEN FUNCTION = wszPath
END FUNCTION
' ========================================================================================
File: AfxPath.inc
' ========================================================================================
' Retrieves the name of the default browser.
' ========================================================================================
FUNCTION AfxGetDefaultBrowserName () AS WSTRING
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
IF SUCCEEDED(AssocQueryStringW(0, %ASSOCSTR_EXECUTABLE, "http", "open", wszPath, SIZEOF(wszPath))) THEN FUNCTION = PATHNAME$(NAMEX, wszPath)
END FUNCTION
' ========================================================================================
File: AfxPath.inc
' ========================================================================================
' Retrieves the path of the default mail client.
' ========================================================================================
FUNCTION AfxGetDefaultMailClientPath () AS WSTRING
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
IF SUCCEEDED(AssocQueryStringW(0, %ASSOCSTR_EXECUTABLE, "mailto", "open", wszPath, SIZEOF(wszPath))) THEN FUNCTION = wszPath
END FUNCTION
' ========================================================================================
File: AfxPath.inc
' ========================================================================================
' Retrieves the name of the default mail client.
' ========================================================================================
FUNCTION AfxGetDefaultMailClientName () AS WSTRING
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
IF SUCCEEDED(AssocQueryStringW(0, %ASSOCSTR_EXECUTABLE, "mailto", "open", wszPath, SIZEOF(wszPath))) THEN FUNCTION = PATHNAME$(NAMEX, wszPath)
END FUNCTION
' ========================================================================================
File: AfxWin.inc.
' ========================================================================================
' Checks if simple MAPI is installed. Returns TRUE or FALSE.
' ========================================================================================
FUNCTION AfxIsSimpleMapiInstalled () AS LONG
LOCAL dwChars AS DWORD, wszReturn AS WSTRINGZ * 260
dwChars = GetPrivateProfileStringW("Mail", "MAPI", BYVAL %NULL, wszReturn, SIZEOF(wszReturn), "win.ini")
IF dwChars THEN FUNCTION = VAL(wszReturn)
END FUNCTION
' ========================================================================================
As there has been interest about using SMTP to send emails, I have taken a class posted by Pauk in the PB Forum and added it to my headers, with minimal changes.
Changed the name of the interfaqce from AfxSmtMail to IAfxSmtpMail for consistency.
File: ButtonCtrl.inc
' ========================================================================================
' Assigns an image list to a button control. Requires Windows XP or superior.
' Parameters:
' - hButon = The handle of the button.
' - hImageList =
' - nLeft = The x-coordinate of the upper-left corner of the rectangle for the image.
' - nTop = The y-coordinate of the upper-left corner of the rectangle for the image.
' - nRight = The x-coordinate of the lower-right corner of the rectangle for the image.
' - nBottom = The y-coordinate of the lower-right corner of the rectangle for the image.
' - uAlign = The alignment to use. This parameter can be one of the following values:
' BUTTON_IMAGELIST_ALIGN_LEFT Align the image with the left margin.
' BUTTON_IMAGELIST_ALIGN_RIGHT Align the image with the right margin
' BUTTON_IMAGELIST_ALIGN_TOP Align the image with the top margin
' BUTTON_IMAGELIST_ALIGN_BOTTOM Align the image with the bottom margin
' BUTTON_IMAGELIST_ALIGN_CENTER Center the image.
' The default value is BUTTON_IMAGELIST_ALIGN_LEFT.
' Return value: If the function succeeds, it returns TRUE. Otherwise it returns FALSE.
' Note: To use this application programming interface (API), you must provide a manifest
' specifying Comclt32.dll version 6.0.
' ========================================================================================
FUNCTION Button_SetImageListXY (BYVAL hButton AS DWORD, BYVAL hImageList AS DWORD, BYVAL nLeft AS LONG, BYVAL nTop AS LONG, BYVAL nRight AS LONG, BYVAL nBottom AS LONG, OPTIONAL BYVAL uALign AS DWORD) AS LONG
LOCAL bi AS BUTTON_IMAGELIST
bi.himl = hImageList : bi.margin.nLeft = nLeft : bi.margin.nTop = nTop
bi.margin.nRight = nRight : bi.margin.nBottom = nBottom : bi.uAlign = uAlign
FUNCTION = SendMessage(hButton, %BCM_SETIMAGELIST, 0, VARPTR(bi))
END FUNCTION
' ========================================================================================
File: AfxFile.inc
' ========================================================================================
' Loads a file and returns its content as a string.
' Parameter:
' - bstrFileSpec = Path of the file to be loaded. By default, the name is limited to MAX_PATH
' characters. To extend this limit to 32,767 wide characters, prepend "\\?\" to the path.
' Return value: A string with the contents of the file.
' ========================================================================================
FUNCTION AfxLoadFileToString (BYVAL bstrFileSpec AS WSTRING) AS STRING
LOCAL hFile AS DWORD
LOCAL dwFileSize AS DWORD
LOCAL dwHighSize AS DWORD
LOCAL bSuccess AS LONG
LOCAL buffer AS STRING
LOCAL dwBytesRead AS DWORD
hFile = CreateFileW(BYCOPY bstrFileSpec, %GENERIC_READ, %FILE_SHARE_READ, _
BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
IF BITSE(hFile, %INVALID_HANDLE_VALUE, 32) THEN EXIT FUNCTION
dwFileSize = GetFileSize(hFile, dwHighSize)
IF dwHighSize THEN
CloseHandle hFile
EXIT FUNCTION
END IF
buffer = SPACE$(dwFileSize)
bSuccess = ReadFile(hFile, BYVAL STRPTR(buffer), dwFileSize, dwBytesRead, BYVAL %NULL)
IF dwBytesRead < dwFileSize THEN buffer = LEFT$(buffer, dwBytesRead)
FUNCTION = buffer
END FUNCTION
' ========================================================================================
File: AfxMisc.inc
Retrieves the address width of the processor. On a 32-bit operating system, the value is 32 and on a 64-bit operating system it is 64. This function can be used to determine if the processor is 32 or 64 bit.
' ========================================================================================
' Retrieves the address width of the processor. On a 32-bit operating system, the value is
' 32 and on a 64-bit operating system it is 64. This function can be used to determine if
' the processor is 32 or 64 bit.
' ========================================================================================
FUNCTION AfxGetAddressWidth () AS WORD
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL wAddressWidth AS WORD ' // uint16
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT AddressWidth FROM Win32_Processor"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.AddressWidth TO wAddressWidth
FUNCTION = wAddressWidth
END FUNCTION
' ========================================================================================
File: AfxMisc.inc
' ========================================================================================
' Retrieves the system running on the Windows-based computer. The following list identifies
' the returned value: "X86-based PC", "MIPS-based PC", "Alpha-based PC", "Power PC",
' "SH-x PC", "StrongARM PC", "64-bit Intel PC", "64-bit Alpha PC", "Unknown", "X86-Nec98 PC".
' ========================================================================================
FUNCTION AfxGetSystemType () AS WSTRING
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL bstrSystemType AS WSTRING ' // System type
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT SystemType FROM Win32_ComputerSystem"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.SystemType TO bstrSystemType
FUNCTION = bstrSystemType
END FUNCTION
' ========================================================================================
File: AfxMisc.inc
' ========================================================================================
' Retrieves the architecture of the operating system, as opposed to the processor.
' Example: 32-bit. Windows Server 2003, Windows 2000, Windows NT 4.0, Windows XP, and
' Windows Me/98/95: This property is not available.
' ========================================================================================
FUNCTION AfxGetOSArchitecture () AS WSTRING
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL bstrArchitecture AS WSTRING ' // Architecture
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT OSArchitecture FROM Win32_OperatingSystem"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.OSArchitecture TO bstrArchitecture
FUNCTION = bstrArchitecture
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the type of the computer in use, such as laptop, desktop, or Tablet.
' Windows Server 2003, Windows XP, Windows 2000, Windows NT 4.0, and Windows Me/98/95:
' This property is not available.
' Value Meaning
' ------- --------------------------------------------¡
' 0 (&H0) Unspecified
' 1 (&H1) Desktop
' 2 (&H2) Mobile
' 3 (&H3) Workstation
' 4 (&H4) Enterprise Server
' 5 (&H5) Small Office and Home Office (SOHO) Server
' 6 (&H6) Appliance PC
' 7 (&H7) Performance Server
' 8 (&H8) Maximum
' ========================================================================================
FUNCTION AfxGetPCSystemType () AS WORD
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL wPCSystemType AS WORD ' // uint16
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT PCSystemType FROM Win32_ComputerSystem"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.PCSystemType TO wPCSystemType
FUNCTION = wPCSystemType
END FUNCTION
' ========================================================================================
File: AfxMisc.inc
' ========================================================================================
' Checks if the computer is part of a domain.
' Return value: If TRUE, the computer is part of a domain. If FALSE, the computer is not
' in a domain or the status is unknown. If you unjoin the computer from a domain, the
' value becomes false.
' ========================================================================================
FUNCTION AfxIsPartOfDomain () AS BYTE
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL bPartOfDomain AS BYTE ' // boolean
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT PartOfDomain FROM Win32_ComputerSystem"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.PartOfDomain TO bPartOfDomain
FUNCTION = bPartOfDomain
END FUNCTION
' ========================================================================================
File: AfxMisc.inc
' ========================================================================================
' Name of the domain or workgroup to which a computer belongs.
' If the computer is not part of a domain, then the name of the workgroup is returned.
' If you need to run in both domain-based and workgroup-based environments, you might
' encounter problems using the %USERDOMAIN% environment variable because if the computer
' is not part of a domain, it returns the name of the local computer instead of the
' name of the workgroup.
' ========================================================================================
FUNCTION AfxGetDomainOrWorkGroup () AS WSTRING
LOCAL hr AS LONG ' // HRESULT
LOCAL pService AS ISWbemServices ' // Services object
LOCAL pObjectSet AS ISWbemObjectSet ' // ISWbemObjectSet interface
LOCAL pEnum AS IEnumVariant ' // Generic collection's enumerator reference
LOCAL bstrDisplayName AS WSTRING ' // Display name
LOCAL bstrQuery AS WSTRING ' // Query string
LOCAL oItem AS DISPATCH ' // Generic object variable
LOCAL vItem AS VARIANT ' // Generic object variant
LOCAL bstrDomainOrWorkGroup AS WSTRING ' // Domain or workgroup name
' // Connect to WMI using a moniker
bstrDisplayName = "winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2"
pService = WmiGetObject(bstrDisplayName)
IF ISNOTHING(pService) THEN EXIT FUNCTION
' // Execute a query to get a reference to the collection of objects
bstrQuery = "SELECT Domain FROM Win32_ComputerSystem"
pObjectSet = pService.ExecQuery(bstrQuery, "WQL", %wbemFlagReturnImmediately)
IF ISNOTHING(pObjectSet) THEN EXIT FUNCTION
' // Retrieve a reference to the collection's enumerator
pEnum = pObjectSet.NewEnum_
IF ISNOTHING(pEnum) THEN EXIT FUNCTION
hr = pEnum.Next(1, vItem, BYVAL %NULL)
IF hr <> %S_OK THEN EXIT FUNCTION
oItem = vItem
vItem = EMPTY
IF ISNOTHING(oItem) THEN EXIT FUNCTION
' // Retrieve the value of the property
OBJECT GET oItem.Domain TO bstrDomainOrWorkGroup
FUNCTION = bstrDomainOrWorkGroup
END FUNCTION
' ========================================================================================
My translation of the SQLite headers will be incorporated to my headers package, since I have writen some classes that use them. The classes allow to use SQLite with structured exception handling and get rich error information.
A little example:
' ########################################################################################
' Microsoft Windows
' File: CSQLITE_Step.bas
' Contents: CSQLite class example
' Connects to a database and reads records.
' Copyright (c) 2012 Jose Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "CSQLite.INC"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN
' // Create an instance of the class
LOCAL pSQL AS ISQLite
pSQL = CLASS "CSQLite"
IF ISNOTHING(pSQL) THEN EXIT FUNCTION
' // Create a connection object
LOCAL pDbc AS ISQLiteConnection
pDbc = pSQL.Connection
IF ISNOTHING(pDbc) THEN EXIT FUNCTION
TRY
' // Delete our test database if it exists
IF ISFILE(EXE.PATH$ & "Test.sdb") THEN KILL EXE.PATH$ & "Test.sdb"
' // Create a new database
pDbc.OpenDatabase(EXE.PATH$ & "Test.sdb")
' // Create a table
pDbc.Exec("CREATE TABLE t (xyz text)")
' // Insert rows
pDbc.Exec("INSERT INTO t (xyz) VALUES ('fruit')")
pDbc.Exec("INSERT INTO t (xyz) VALUES ('fish')")
' ' // Prepare a query
LOCAL pStmt AS ISQLiteStatement
pStmt = pDbc.Prepare("SELECT * FROM t")
? "Column count:" & STR$(pStmt.ColumnCount)
' // Read the column names and values
LOCAL i AS LONG
DO
' // Fetch rows of the result set
IF pStmt.Step = %SQLITE_DONE THEN EXIT DO
' // Read the columns and values
FOR i = 0 TO pStmt.ColumnCount- 1
? pStmt.ColumnName(i)
? pStmt.ColumnText(i)
NEXT
LOOP
CATCH
' // Display error information
? pSql.OleErrorInfo
END TRY
' // Cleanup
pDbc = NOTHING ' // Closes the database
pSQL = NOTHING
#IF %DEF(%PB_CC32)
WAITKEY$
#ENDIF
END FUNCTION
' ========================================================================================
File AfxWin.inc
' ========================================================================================
' Retrieves the path of the executable file given its instance handle.
' ========================================================================================
FUNCTION AfxGetPathFromhInstance (BYVAL hInst AS DWORD) AS WSTRING
LOCAL hProcess AS DWORD, wszPath AS WSTRINGZ * %MAX_PATH
IF hInst = 0 THEN EXIT FUNCTION
hProcess = OpenProcess(%PROCESS_QUERY_INFORMATION OR %PROCESS_VM_READ, %FALSE, hInst)
IF hProcess = 0 THEN EXIT FUNCTION
GetModuleFileNameExW(hProcess, %NULL, wszPath, SIZEOF(wszPath))
CloseHandle(hProcess)
FUNCTION = wszPath
END FUNCTION
' ========================================================================================
File AfxWin.inc
' ========================================================================================
' Retrieves the path of the executable file that created the specified window.
' ========================================================================================
FUNCTION AfxGetPathFromWindowHandle (BYVAL hwnd AS DWORD) AS WSTRING
LOCAL idProc, hProcess AS DWORD, wszPath AS WSTRINGZ * %MAX_PATH
GetWindowThreadProcessId(hwnd, idProc)
IF idProc = 0 THEN EXIT FUNCTION
hProcess = OpenProcess(%PROCESS_QUERY_INFORMATION OR %PROCESS_VM_READ, %FALSE, idProc)
IF hProcess = 0 THEN EXIT FUNCTION
GetModuleFileNameExW(hProcess, %NULL, wszPath, SIZEOF(wszPath))
CloseHandle(hProcess)
FUNCTION = wszPath
END FUNCTION
' ========================================================================================