Jump to content
Tuts 4 You

PureBasic Adventures...

Sign in to follow this  
  • entries
    7
  • comments
    10
  • views
    31,064

About this blog

 

 

 

Entries in this blog

 

ExtractIconEx Revisited...

With the excitement of Windows 10 and a host of bug fixes out of the way I can now concentrate some time on Tuts 4 You which also allows me to post some code on this blog. This blog entry is in regard to a recent query from LCF on viewing icons contained within DLL's, executables, icon files, etc. I coded a small tool for this a while ago that enabled me to quickly view icons contained primarily within shell32.dll and imageres.dll so that I could take advantage of those icons in other code. Most of the magic is done by Windows API ExtractIconEx function and from there we simply manipulate the icon images to display them in a gadget list window. As you can see from the code below I have taken advantage of mixing both Windows API with PureBasic API's to achieve the results. For those of you who have read my previous blog entries may be astute enough to see the similarities with the code posted in my PureBasic Adventures blog entry. The attached archive contains compiled code for those who would like to see use the end result and do not have PureBasic installed (shame on you!). The archive also contains the .pb code file(s) and some rough bonus code using DrawIconEx API to draw icons directly to a window... UsePNGImageEncoder() ; Declare the procedures... Declare Menu_ExtractIcon() Declare Menu_ExtractIconAll() Declare Menu_About() Declare Menu_Callback(hWnd, uMsg, wParam, lParam) ; Declare some global variables... Global Gadget Global FileName.s Global Title.s = "Quick Icon Viewer v0.1" Global Info.s = "A small program to view and extract icons as .BMP or .PNG."+Chr(13)+Chr(13)+"Code: Teddy Rogers"+Chr(13)+"URL: http://tuts4you.com"+Chr(13)+"E-Mail: teddyrogers@tuts4you.com" ; Create our window and explorer list gadget then let the magic happen... If OpenWindow(0, #Null, #Null, 600, 500, Title.s, #PB_Window_ScreenCentered | #PB_Window_SystemMenu) ExplorerListGadget(0, 1, 2, 598, 297, GetCurrentDirectory(), #PB_Explorer_GridLines | #PB_Explorer_AutoSort | #PB_Explorer_HiddenFiles | #PB_Explorer_FullRowSelect) ; Create the icon gadget windows and set the attributes to display small and large icons... ListIconGadget(1, 1, 300, 299, 176, "", #Null) ListIconGadget(2, 301, 300, 298, 176, "", #Null) ; Customise the list icon display mode... SetGadgetAttribute(1, #PB_ListIcon_DisplayMode, #PB_ListIcon_SmallIcon) SetGadgetAttribute(2, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon) ; Create the status bar and text fields for some stats/counters... If CreateStatusBar(0, WindowID(0)) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) StatusBarText(0, 0, "Small Icons (16 x 16) :", #PB_StatusBar_Right) StatusBarText(0, 2, "Large Icons (32 x 32) :", #PB_StatusBar_Right) EndIf ; Create the popup menu and bind the menu events... If CreatePopupMenu(MyMenu) MenuItem(1, "Extract") MenuItem(2, "Extract All") MenuBar() MenuItem(3, "About") BindMenuEvent(MyMenu, 1, @Menu_ExtractIcon()) BindMenuEvent(MyMenu, 2, @Menu_ExtractIconAll()) BindMenuEvent(MyMenu, 3, @Menu_About()) ; Create the callback to process the events in the icon gadget lists... SetWindowCallback(@Menu_Callback()) EndIf Repeat MyEvent = WaitWindowEvent() Select MyEvent Case #PB_Event_Gadget Select EventGadget() Case 0 Select EventType() Case #PB_EventType_Change ; Auto size the four explorer list gadget columns... For i = 0 To 4 SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER) Next i Case #PB_EventType_LeftClick ; Check if the user selected a different file in the explorer gadget list before processing new events... If FileName.s <> GetGadgetText(0) + GetGadgetItemText(0, GetGadgetState(0)) ; Get the directory and file name from ExplorerListGadget... FileName.s = GetGadgetText(0) + GetGadgetItemText(0, GetGadgetState(0)) ; Clear up any previously diaplyed icons... ClearGadgetItems(1) : ClearGadgetItems(2) ; Return the total number of icons in the specified file... IconNum = ExtractIconEx_(PeekS(@FileName), -1, #Null, #Null, #Null) ; Create a simple array for storing the small and large icons... Dim hIcon_Small(IconNum) : Dim hIcon_Large(IconNum) ; Extract the icons in to the array... If IconNum ExtractIconEx_(PeekS(@FileName), #Null, hIcon_Large(), hIcon_Small(), IconNum) EndIf ; Change the window icon. Using SHGetFileInfo retrieves file, folder, directory, and drive icons... If SHGetFileInfo_(PeekS(@FileName), #FILE_ATTRIBUTE_NORMAL, @FileIcons.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES) SetClassLongPtr_(WindowID(0), #GCL_HICON, FileIcons\hIcon) DestroyIcon_(FileIcons\hIcon) EndIf ; Add the icons stored in the array to the gadget list and destroy the icon in the array... For a = 0 To IconNum - 1 If hIcon_Small(a) AddGadgetItem(1, -1, Str(a) + " / $" + Hex(a), hIcon_Small(a)) DestroyIcon_(hIcon_Small(a)) EndIf If hIcon_Large(a) AddGadgetItem(2, -1, Str(a) + " / $" + Hex(a), hIcon_Large(a)) DestroyIcon_(hIcon_Large(a)) EndIf Next a ; When we are finished displaying the icons in the gadget list free both arrays from memory... FreeArray(hIcon_Small()) FreeArray(hIcon_Large()) ; Count the items in each of the icon gadget windows... StatusBarText(0, 1, Str(CountGadgetItems(1)), #PB_StatusBar_Center) StatusBarText(0, 3, Str(CountGadgetItems(2)), #PB_StatusBar_Center) EndIf EndSelect Case 1 Select EventType() Case #PB_EventType_LeftClick ; First check to see if there are any icons in the gadget then change the window icon... If GetGadgetState(1) => 0 If ExtractIconEx_(PeekS(@FileName), GetGadgetState(1), #Null, @iIcon, 1) SetClassLongPtr_(WindowID(0), #GCL_HICON, iIcon) DestroyIcon_(iIcon) EndIf EndIf EndSelect Case 2 Select EventType() Case #PB_EventType_LeftClick ; First check to see if there are any icons in the gadget then change the window icon... If GetGadgetState(2) => 0 If ExtractIconEx_(PeekS(@FileName), GetGadgetState(2), @iIcon, #Null, 1) SetClassLongPtr_(WindowID(0), #GCL_HICON, iIcon) DestroyIcon_(iIcon) EndIf EndIf EndSelect EndSelect EndSelect Until MyEvent = #PB_Event_CloseWindow EndIf Procedure Menu_ExtractIcon() Protected MyImage, x, SaveFilename.s, ImageFormat, Extension.s ; If there are no icons selected create an error message then exit procedure... If GetGadgetState(Gadget) = -1 MessageRequester("Error!", "There is no image to save!", #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) ProcedureReturn EndIf ; Show the save dialogue and ask user to input file name, we can create a default filename based upon current date/time... SaveFilename.s = SaveFileRequester("Saving your image...", FormatDate("%yyyy.%mm.%dd-%hh.%ii.%ss", Date()), "PNG Format|*.png|BMP Format|*.bmp", #Null) ; Store the required extension and format type... Select SelectedFilePattern() Case 0 ; PNG ImageFormat = #PB_ImagePlugin_PNG Extension.s = ".png" Case 1 ; BMP ImageFormat = #PB_ImagePlugin_BMP Extension.s = ".bmp" EndSelect ; If called from small gadget list we want small icons and vice-versa for large, then extract a single icon... If Gadget = 1 ExtractIconEx_(PeekS(@FileName), GetGadgetState(Gadget), #Null, @iIcon, 1) x = 16 Else ExtractIconEx_(PeekS(@FileName), GetGadgetState(Gadget), @iIcon, #Null, 1) x = 32 EndIf ; Create a new image then draw the icon to it... If CreateImage(MyImage, x, x, 32) StartDrawing(ImageOutput(MyImage)) DrawingMode(#PB_2DDrawing_AllChannels) DrawImage(iIcon, 0, 0, x, x) StopDrawing() EndIf ; Destroy the icon in the array to prevent GDI leaks... DestroyIcon_(iIcon) ; If the image is a valid image save it then free the new image from memory when done... If IsImage(MyImage) If SaveImage(MyImage, SaveFilename.s + Extension.s, ImageFormat) FreeImage(MyImage) EndIf EndIf ProcedureReturn EndProcedure Procedure Menu_ExtractIconAll() Protected MyImage, x, a, SaveFilename.s, ImageFormat, Extension.s ; If there are no icons selected create an error message then exit procedure... If GetGadgetState(Gadget) = -1 MessageRequester("Error!", "There are no images to save!", #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) ProcedureReturn EndIf ; Show the save dialogue and ask user to input file name, we can create a default filename based upon current date/time... SaveFilename.s = SaveFileRequester("Saving all your images...", FormatDate("%yyyy.%mm.%dd-%hh.%ii.%ss", Date()), "PNG Format|*.png|BMP Format|*.bmp", #Null) ; Store the required extension and format type... Select SelectedFilePattern() Case 0 ; PNG ImageFormat = #PB_ImagePlugin_PNG Extension.s = ".png" Case 1 ; BMP ImageFormat = #PB_ImagePlugin_BMP Extension.s = ".bmp" EndSelect ; If called from small gadget list we want small icons and vice-versa for large, then extract all icons in to an array... If Gadget = 1 Dim iIcon(CountGadgetItems(1)) ExtractIconEx_(PeekS(@FileName), #Null, #Null, iIcon(), ArraySize(iIcon())) x = 16 Else Dim iIcon(CountGadgetItems(2)) ExtractIconEx_(PeekS(@FileName), #Null, iIcon(), #Null, ArraySize(iIcon())) x = 32 EndIf ; Create a new image then draw the icon to it... For a = 0 To ArraySize(iIcon()) - 1 If CreateImage(MyImage, x, x, 32) StartDrawing(ImageOutput(MyImage)) DrawingMode(#PB_2DDrawing_AllChannels) DrawImage(iIcon(a), 0, 0, x, x) StopDrawing() EndIf ; Destroy the icon in the array to prevent GDI leaks... DestroyIcon_(iIcon(a)) ; If the image is a valid image save it then free the new image from memory when done... If IsImage(MyImage) If SaveImage(MyImage, SaveFilename.s + Str(a) + Extension.s, ImageFormat) FreeImage(MyImage) EndIf EndIf ; Process next icon in the array until all complete then free the array... Next a FreeArray(iIcon()) ProcedureReturn EndProcedure Procedure Menu_About() MessageRequester(Title.s, Info.s, #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) EndProcedure Procedure Menu_Callback(hWnd, uMsg, wParam, lParam) If uMsg = #WM_CONTEXTMENU Select wParam Case GadgetID(1) DisplayPopupMenu(MyMenu, WindowID(0)) Gadget = 1 Case GadgetID(2) DisplayPopupMenu(MyMenu, WindowID(0)) Gadget = 2 EndSelect EndIf ProcedureReturn #PB_ProcessPureBasicEvents EndProcedure   The "cycle icons" sample found in the attached archive...   Declare CycleIcons(void) If OpenWindow(0, 0, 0, 100, 100, "CycleIcons", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) CreateThread(@CycleIcons(), #Null) Repeat Event = WaitWindowEvent() Until Event = #PB_Event_CloseWindow EndIf Procedure CycleIcons(void) FileName.s = GetCurrentDirectory() + "\test files\imageres.dll" IconNum = ExtractIconEx_(FileName.s, -1, #Null, #Null, #Null) Dim hIcon_Small(IconNum) Dim hIcon_Large(IconNum) ExtractIconEx_(FileName.s, 0, hIcon_Large(), hIcon_Small(), IconNum) hDC = GetDC_(WindowID(0)) For a = 0 To IconNum - 1 ExtFloodFill_(hDC, #Null, #Null, $f123, #FLOODFILLBORDER) SetWindowText_(WindowID(0), "Icon: " + a + "/" + Hex(a)) SetClassLongPtr_(WindowID(0), #GCL_HICON, hIcon_Small(a)) DrawIconEx_(hDC, 25, 30, hIcon_Small(a), #Null, #Null, #Null, #Null, #DI_NORMAL) DrawIconEx_(hDC, 65, 30, hIcon_Large(a), #Null, #Null, #Null, #Null, #DI_NORMAL) DestroyIcon_(hIcon_Small(a)) DestroyIcon_(hIcon_Large(a)) Sleep_(500) Next a DeleteDC_(hDC) EndProcedure
Ted. Quick Icon Viewer.zip

Teddy Rogers

Teddy Rogers

 

System Up-Time Since BootTime...

Last week I read a blog entry by Raymond Chan regarding the way Task Manager computes the systems up-time and it reminded me of a bug I noticed in AID64's implementation. On Sunday I had a bit of free time before the Manchester United vs Arsenal game kicked off and decided to see what I could come up with.   There are a dozen different methods for calculating up-time, some methods are better and some of these do factor in leap years. Raymond's particular blog mentioned the use of GetTickCount API (contradictory to what he implies it does include sleep time), that method seems a little long winded if your end result is to format the result in to; years, month, days, hours, minutes and seconds. I'll show you a simpler way by using NtQuerySystemInformation and taking advantage of Windows API time functions. You can also use this method if you want to compute the time between two different dates such as how old someone is, although Windows Calculator has that covered with it's date calculations. Of course the example code below is in PureBasic, if you have queries regarding the code please comment...   Declare UpdateSystemTime(void) If OpenWindow(0, 0, 0, 400, 65, "System Up-Time Since BootTime...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) TextGadget(1, 10, 10, 95, 20, "System Boot Time :") TextGadget(2, 105, 10, 200, 20, "") TextGadget(3, 10, 35, 50, 20, "UpTime :") TextGadget(4, 60, 35, 400, 20, "") CreateThread(@UpdateSystemTime(), #Null) Repeat MyEvent = WaitWindowEvent() Until MyEvent = #PB_Event_CloseWindow EndIf Procedure UpdateSystemTime(void) #SystemTimeOfDayInformation = 3 #STATUS_SUCCESS = 0 Structure SYSTEM_TIMEOFDAY_INFORMATION ; We are only concerned about BootTime and CurrentTime members of this structure. BootTime.FILETIME CurrentTime.FILETIME EndStructure Protected SystemBootTime.SYSTEM_TIMEOFDAY_INFORMATION ; SystemInformation parameter should be large enough to hold an opaque SYSTEM_TIMEOFDAY_INFORMATION structure. Repeat ; Use NtQuerySystemInformation to retrieve BootTime and Current time information. Note "NtQuerySystemInformation may be altered or unavailable in future versions of Windows". If NtQuerySystemInformation_(#SystemTimeOfDayInformation, @SystemBootTime, SizeOf(SystemBootTime), #Null) = #STATUS_SUCCESS ; Subtract the high and low order parts of the file time from LocalTime and BootTime to calculate the time and date difference. SystemBootTime\CurrentTime\dwLowDateTime - SystemBootTime\BootTime\dwLowDateTime SystemBootTime\CurrentTime\dwHighDateTime - SystemBootTime\BootTime\dwHighDateTime ; Convert the FILETIME structure into a time that is easy to display to a user. FileTimeToSystemTime_(@SystemBootTime\BootTime, @lpSystemTime_BootTime.SYSTEMTIME) FileTimeToSystemTime_(@SystemBootTime\CurrentTime, @lpSystemTime_CurrentTime.SYSTEMTIME) ; Convert BootTime time in Coordinated Universal Time (UTC) to local time. SystemTimeToTzSpecificLocalTime_(#Null, @lpSystemTime_BootTime, @lpSystemTime_BootTime) ; Contains a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC) - offset from this date. lpSystemTime_CurrentTime\wYear - 1601 lpSystemTime_CurrentTime\wMonth - 1 lpSystemTime_CurrentTime\wDay - 1 ; Display date and time difference as UpTime Since Last Reboot... SetGadgetText(2, Str(lpSystemTime_BootTime\wDay) + "/" + Str(lpSystemTime_BootTime\wMonth) + "/" + Str(lpSystemTime_BootTime\wYear) + " @ " + Str(lpSystemTime_BootTime\wHour) + ":" + Str(lpSystemTime_BootTime\wMinute) + ":" + Str(lpSystemTime_BootTime\wSecond)) SetGadgetText(4, Str(lpSystemTime_CurrentTime\wYear) + " years, " + Str(lpSystemTime_CurrentTime\wMonth) + " months, " + Str(lpSystemTime_CurrentTime\wDay) + " days, (" + Str(lpSystemTime_CurrentTime\wHour) + " hours, " + Str(lpSystemTime_CurrentTime\wMinute) + " minutes, " + Str(lpSystemTime_CurrentTime\wSecond) + " seconds)") ; Cycle once every second... Sleep_(1000) Else MessageBox_(#Null, "Could not retrieve system information...", "Peanut!", #MB_ICONERROR | #MB_TOPMOST | #MB_SETFOREGROUND) Break EndIf ForEver EndProcedure   Ted. System Up-Time Since BootTime.zip

Teddy Rogers

Teddy Rogers

 

Calendar Date Format...

A query was raised last week about how to determine the calendar date format for different regions; year/month/day, day/month/year, etc. After a bit of fruitless pondering whether this could be achieved via API I decided to see if it could be done via the registry. Multiple editions of Windows support the International registry subkey and from there we can use either sShortDate or sLongDate to help us reach our goal. The operating system kindly finds and formats the calendar date in the correct regional order when the user configures their region in the Control Panel or during installation. I chose sShortDate and replaced those known registry values with the values retrieved from the SYSTEMTIME structure. Below is the example...   ; Setup string and data sizes for storing date values... DateValue.s = Space(20) : DateSize = Len(DateValue) ; Open registry and retrieve the local calendar/date format If RegOpenKeyEx_(#HKEY_CURRENT_USER, "Control Panel\International", #Null, #KEY_READ, @DateFormat) = #ERROR_SUCCESS If RegQueryValueEx_(DateFormat, "sShortDate", #Null, #Null, @DateValue, @DateSize) = #ERROR_SUCCESS ; Receive the local date GetLocalTime_(@lpSystemTime.SYSTEMTIME) ; Find registry string values and replace string values from SYSTEMTIME structure DateValue = ReplaceString(DateValue, "yyyy", Str(lpSystemTime\wYear)) DateValue = ReplaceString(DateValue, "yy", Str(lpSystemTime\wYear)) DateValue = ReplaceString(DateValue, "MM", Str(lpSystemTime\wMonth)) DateValue = ReplaceString(DateValue, "M", Str(lpSystemTime\wMonth)) DateValue = ReplaceString(DateValue, "dd", Str(lpSystemTime\wDay)) DateValue = ReplaceString(DateValue, "d", Str(lpSystemTime\wDay)) ; Display the date MessageBox_(#Null, DateValue, "What is the date today?", #MB_ICONQUESTION | #MB_TOPMOST | #MB_SETFOREGROUND) EndIf RegCloseKey_(DateFormat) EndIf   If you know of a way this can be done purely by API please let me know...   Ted. Todays Date.zip

Teddy Rogers

Teddy Rogers

 

DebugBlocker()

Here is a simple example in PureBasic code for using a self-debugger, commonly referred to as Debug Blocker. Compile (or run one of the attached executables in the archive) and click on the "CLICK ME!" button to create a duplicate process being self-debugged. Any queries about the code please comment below...   ; ------------------------------------------------------------------ ; ; PureBasic DebugBlocker() function, creates a copy of the currently running ; process as a child and attaches to it for self-debugging. This method is ; commonly referred to as "self-debugging" or "Debug Blocker" and is used ; to protect the parent (now child) process from being debugged. Only one ; Ring-3 debugger can be attached to a process in Windows OS. ; ; Return Values: ; ; This function does not return a value. ; ; Remarks: ; ; Debugging events and actions are handled within the function. ; ; By Teddy Rogers / PureBasic 5.24 LTS ; ; ------------------------------------------------------------------ Declare DebugBlocker() If OpenWindow(1, #Null, #Null, 300, 60, "Self-debugging Example", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) ButtonGadget(1, 5, 5, 290, 50, "CLICK ME!", #PB_Button_MultiLine) Repeat MyEvent = WaitWindowEvent() Select MyEvent Case #PB_Event_Gadget Select EventGadget() Case 1 DebugBlocker() EndSelect EndSelect Until MyEvent = #PB_Event_CloseWindow EndIf ; A very simple example of self-debugging (Debug-Blocker)... Procedure DebugBlocker() Protected ghMutex, EXIT_PROCESS_DEBUG_EVENT ; Create a mutex object, we can use it as an identity to limit the number of spawned processes to be self-debugged... ghMutex = CreateMutex_(#Null, #True, "Blocker_Mutex") If ghMutex = #Null Or GetLastError_() = #ERROR_ALREADY_EXISTS ; If return handle is the existing object GetLastError returns ERROR_ALREADY_EXISTS. CloseHandle_(ghMutex) MessageBox_(WindowID(1), "Self-debugging already in progress...", "Error", #MB_ICONERROR | #MB_TOPMOST | #MB_SETFOREGROUND) ProcedureReturn EndIf ; Find out who we are and create a duplicate process of ourselves... GetStartupInfo_(lpStartupInfo.STARTUPINFO) If CreateProcess_(#Null, GetCommandLine_(), #Null, #Null, #False, #DEBUG_PROCESS, #Null, #Null, @lpStartupInfo, @lpProcessInformation.PROCESS_INFORMATION) ; Infinitely wait for the debugging event EXIT_PROCESS_DEBUG_EVENT in our new process... Repeat If WaitForDebugEvent_(@myDebug.DEBUG_EVENT, -1) If PeekB(@myDebug\dwDebugEventCode) = #EXIT_PROCESS_DEBUG_EVENT EXIT_PROCESS_DEBUG_EVENT = #True EndIf EndIf ; Continue debugging the process... If Not ContinueDebugEvent_(myDebug\dwProcessId, myDebug\dwThreadId, #DBG_CONTINUE) MessageBox_(WindowID(1), "Debugging error!", "Error", #MB_ICONERROR | #MB_TOPMOST | #MB_SETFOREGROUND) EndIf Until EXIT_PROCESS_DEBUG_EVENT ; Tidy up process handles identified in the PROCESS_INFORMATION structure... CloseHandle_(lpProcessInformation\hProcess) CloseHandle_(lpProcessInformation\hThread) EndIf ReleaseMutex_(ghMutex) CloseHandle_(ghMutex) ; Destroy the created Blocker_Mutex EndProcedure   Ted. Debug Blocker.zip

Teddy Rogers

Teddy Rogers

 

PW_RENDERFULLCONTENT

Apparently... Windows 8.1 came with a new flag for PrintWindow called, PW_RENDERFULLCONTENT. This allows PrintWindow to properly capture window content that is displaying DirectX through DWM.   Below are some screenshots taken of Unreal Tournament. The first is how PrintWindow normally captures a window with DirectX content being rendered inside it, notice the window border is missing and there is corrupted graphics on the right. The second screenshot is taken with PW_RENDERFULLCONTENT...       Below is an example using PureBasic code, there isn't much information about PW_RENDERFULLCONTENT and it is currently undocumented on MSDN. I am sure if I had a bit more spare time I could find a more worthy example to show you than the above images. You get the idea though...   UsePNGImageEncoder() Declare PrintScreen(hWnd) Prototype.i PrintWindow(hWnd, hdcBlt, nFlags)Global PrintWindow.PrintWindow If OpenWindow(1, #Null, #Null, #Null, #Null, "Capture Window", #PB_Window_Invisible) Repeat MyEvent = WaitWindowEvent() If GetAsyncKeyState_(#VK_SNAPSHOT) & $8000 PrintScreen(FindWindow_(#Null, "Unreal Tournament")) EndIf If GetAsyncKeyState_(#VK_ESCAPE) & $8000 MyEvent = #PB_Event_CloseWindow EndIf Until MyEvent = #PB_Event_CloseWindow EndIf Procedure PrintScreen(hWnd) Protected r.RECT #PW_RENDERFULLCONTENT = $00000002 If OpenLibrary(User32, "User32.dll") PrintWindow = GetFunction(User32, "PrintWindow") If GetWindowRect_(hWnd, r.RECT) If CreateImage(CapImage, r\right-r\left, r\bottom-r\top, 32) hdc = StartDrawing(ImageOutput(CapImage)) ; PW_RENDERFULLCONTENT -> new in Windows 8.1, can capture DirectX screens through DWM Okay = PrintWindow(hWnd, hdc, #PW_RENDERFULLCONTENT) StopDrawing() If Okay SaveImage(CapImage, "C:\Users\Teddy\Downloads\" + FormatDate("%yyyy.%mm.%DD-%hh.%ii.%ss", Date()) + ".png", #PB_ImagePlugin_PNG) CloseLibrary(User32) ProcedureReturn EndIf EndIf EndIf CloseLibrary(User32) EndIf EndProcedure   If you have more information or details on PW_RENDERFULLCONTENT please tell me about it...   Ted.

Teddy Rogers

Teddy Rogers

 

IsUserAnAdministrator()

I needed some code in PureBasic to check if the logged in user and/or running process is a member of the Administrator group. There is IsUserAnAdmin function, it works and is easy to include in your code...   If IsUserAnAdmin_() Debug "Running as an Adminstrator" Else Debug "Running as a Limited User" EndIf   Unfortunately as Microsoft states on MSDN it's a wrapper on a short lifespan, support for it ended with Windows Vista but the function still works in Windows 8.1. Microsoft suggests using the CheckTokenMembership function with the SID identifier NtAthority which, requires a little bit more code to be backward and future proof. Fortunately Microsoft provides example C++ code on MSDN, porting it to PureBasic requires a bit more work, the code below is a translation of this code...   ; ------------------------------------------------------------------ ; ; PureBasic IsUserAnAdministrator() function to check if the callers process ; is a member of the Administrators group. Code taken from Microsofts ; example shown at CheckTokenMembership function. ; ; Return Value: ; ; TRUE - Caller has Administrators local group. ; FALSE - Caller does not have Administrators local group. ; ; http://msdn.microsoft.com/en-us/library/windows/desktop/aa376389%28v=vs.85%29.aspx ; ; See SID structures: ; ; http://msdn.microsoft.com/en-us/library/cc980032.aspx ; http://technet.microsoft.com/en-us/library/cc778824%28v=WS.10%29.aspx ; ; By Teddy Rogers / PureBasic 5.24 LTS ; ; ------------------------------------------------------------------ Prototype.i CheckTokenMembership(TokenHandle, SidToCheck, IsMember) Global CheckTokenMembership.CheckTokenMembership Prototype.i AllocateAndInitializeSid(pIdentifierAuthority, nSubAuthorityCount, dwSubAuthority0, dwSubAuthority1, dwSubAuthority2, dwSubAuthority3, dwSubAuthority4, dwSubAuthority5, dwSubAuthority6, dwSubAuthority7, pSid) Global AllocateAndInitializeSid.AllocateAndInitializeSid Prototype.i FreeSid(pSid) Global FreeSid.FreeSid Procedure IsUserAnAdministrator() Protected IsMember, *AdministratorsGroup Structure NtAuthority NtAuthority.b[6] EndStructure Define SECURITY_NT_AUTHORITY.NtAuthority If OpenLibrary(advapi32, "advapi32.dll") CheckTokenMembership = GetFunction(advapi32, "CheckTokenMembership") If CheckTokenMembership AllocateAndInitializeSid = GetFunction(advapi32, "AllocateAndInitializeSid") If AllocateAndInitializeSid FreeSid = GetFunction(advapi32, "FreeSid") If FreeSid SECURITY_NT_AUTHORITY\NtAuthority[5]=5 ; The AllocateAndInitializeSid function allocates and initializes a security identifier (SID) with up to eight subauthorities. If AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, #SECURITY_BUILTIN_DOMAIN_RID, #DOMAIN_ALIAS_RID_ADMINS, #Null, #Null, #Null, #Null, #Null, #Null, @*AdministratorsGroup) CheckTokenMembership(#Null, *AdministratorsGroup, @IsMember) EndIf FreeSid(*AdministratorsGroup) EndIf EndIf EndIf CloseLibrary(advapi32) EndIf ProcedureReturn IsMember EndProcedure Debug IsUserAnAdministrator()   Ted.

Teddy Rogers

Teddy Rogers

 

PureBasic Adventures...

Last year a friend of mine was talking about PureBasic and how easy and good it was for coding and how much he liked working with it. I didn't really take much notice of it - it was just another Basic language, right?! Earlier this year he started showing off some of his remade old school crack intro's and demos from way back in the early 80's and 90's from the Amiga scene including some general effects so I decided to download a copy of PureBasic and tried out some of the features of the language. I liked it so much that I ended up purchasing a licence for PureBasic and have been using it ever since when I've needed to quickly code some tool or another. Why do I like it? Simply because of the ease in which I can get something done with minimal fuss and time. I can access all Windows API's and code can be natively compiled (and switched) between 32 and 64 bit with a couple of mouse clicks and PureBasics own command set is extensive. It's a very good basic language. I don't normally do blogs, it's not my thing. I certainly don't have the time but I want to help spread the language. I'm likely not going to be posting amazing demo effects as I don't have the time to be spending on such things but I will post some snippets of code I needed to come up with in PureBasic for applications or tools. I can't promise you will be wowed or amazed by any of the samples I'm really just going to be posting things I've worked on and included in some programs or just code snippets to better understand how PureBasic works. The first PureBasic sample I am going to post is some test code for a tool I coded where I needed multiple animated tray icons to be displayed to provide various information to the user. I hadn't found any similar code in PureBasic either in the example or archived code libraries or in the PureBasic forums. This example creates two tray icons that cycles through imageres.dll via threads. Imageres.dll is basically an image library that comes with Windows, I believe its on Vista and later and its similar to shell32.dll but with nicer icons and a larger library. The example also listens out for the TaskbarCreated Windows message, if the taskbar crashes and has to reload and your application does not listen for the TaskbarCreated message your trayicon will not reappear. Cycling through the icons was a cheap way to get some "animation" to show up in the example. A callback is created to listen for events happening over the tray icons such as mouse clicks and mouse hover. Normally if you have only one icon in your program you don't have to use callbacks, I needed the callbacks because it was the only way I could get multiple icons working affectively in PureBasic. The threads are used to stop the trayicons locking up once the cycling of the icons is started. I have added some comments but if you have any particular questions about the example please ask... ; ; ------------------------------------------------------------------ ; ; Dual SysTray, Threaded & "Animated" "imageres.dll" System Icons ; "imageres.dll" is available on Window 7 & 8 (Vista??) ; ; By Teddy Rogers / PureBasic 5.22 ; ; ------------------------------------------------------------------ ; ; Declare our procedures Declare WinCallback_Icon1(WindowID, uMsg, wParam, lParam) Declare WinCallback_Icon2(WindowID, uMsg, wParam, lParam) Declare SetImage(Icon) Declare ChangeIcon(void) ; Declare some global variables... Global Num1 = 100 ; Set our default "imageres.dll" tray icon 1 Global Num2 = 101 ; Set our default "imageres.dll" tray icon 2 Global ThreadID ; This is used to end the thread Global IconNum = ExtractIconEx_("imageres.dll", -1, #Null, #Null, #Null) ; Register a message with the "TaskbarCreated" string Global TaskbarRestart = RegisterWindowMessage_("TaskbarCreated") ; Define two windows for seperate icons/menu's and callbacks If OpenWindow(1, 0, 0, 0, 0, "", #PB_Window_Invisible) If OpenWindow(2, 0, 0, 0, 0, "", #PB_Window_Invisible) ; These are the callbacks to watch for events on each of the icons SetWindowCallback(@WinCallback_Icon1(), 1) SetWindowCallback(@WinCallback_Icon2(), 2) ; Add the system tray icons using icons from "imageres.dll" AddSysTrayIcon(1, WindowID(1), SetImage(Num1)) AddSysTrayIcon(2, WindowID(2), SetImage(Num2)) ; Setup some tooltips... SysTrayIconToolTip(1, "You are hovering over icon 1") SysTrayIconToolTip(2, "You are hovering over icon 2") ; Create icon 1 menu with PureBasic modern look (we use "imageres.dll" for menu icons) If CreatePopupImageMenu(1, #PB_Menu_ModernLook) MenuItem(01, "Open", SetImage(174)) MenuItem(02, "Save", SetImage(39)) MenuItem(03, "Save as", SetImage(23)) MenuItem(04, "Quit", SetImage(84)) MenuBar() OpenSubMenu("Recent files") MenuItem(05, "PureBasic.exe") MenuItem(06, "Test.txt") CloseSubMenu() EndIf ; Create icon 2 menu with standard look (we use "imageres.dll" for menu icons) If CreatePopupImageMenu(2, 0) MenuItem(07, "Open", SetImage(174)) MenuItem(08, "Save", SetImage(39)) MenuItem(09, "Save as", SetImage(23)) MenuItem(10, "Quit", SetImage(84)) MenuBar() OpenSubMenu("Recent files") MenuItem(11, "PureBasic.exe") MenuItem(12, "Test.txt") CloseSubMenu() EndIf ; Wait for a MenuItem to be selected... then do some stuff... Repeat Event = WaitWindowEvent() Select Event Case #PB_Event_Menu Select EventMenu() ; Icon 1 menu actions... Case 01 : Debug "Menu: Open (Icon 1)" Case 02 : Debug "Menu: Save (Icon 1)" Case 03 : Debug "Menu: Save as (Icon 1)" Case 04 : End Case 05 : Debug "Menu: PureBasic.exe (Icon 1)" Case 06 : Debug "Menu: Text.txt (Icon 1)" ; Icon 2 menu actions... Case 07 : Debug "Menu: Open (Icon 2)" Case 08 : Debug "Menu: Save (Icon 2)" Case 09 : Debug "Menu: Save as (Icon 2)" Case 10 : End Case 11 : Debug "Menu: PureBasic.exe (Icon 2)" Case 12 : Debug "Menu: Text.txt (Icon 2)" EndSelect EndSelect Until Event = #PB_Event_CloseWindow EndIf EndIf ; We will use the Windows default system icons for our own the menu options Procedure SetImage(Icon) ExtractIconEx_("imageres.dll", Icon, 0, @iIcon, 1) If CreateImage(MyImage, 16, 16 ,32) StartDrawing(ImageOutput(MyImage)) Box(0, 0, 16, 16, GetSysColor_(#COLOR_MENU)) DrawingMode(#PB_2DDrawing_AllChannels) DrawImage(iIcon, 0, 0, 16, 16) StopDrawing() EndIf DestroyIcon_(iIcon) ProcedureReturn ImageID(MyImage) EndProcedure ; Icon Number 1 (clicking left mouse button starts automatic cycling through the icons, clicking left again end the thread) Procedure WinCallback_Icon1(WindowID, uMsg, wParam, lParam) ; End the thread if it is already running or start it... Select lParam Case #WM_LBUTTONDOWN If ThreadID ThreadID = #Null Else ThreadID = CreateThread(@ChangeIcon(), 0) EndIf ; Display popup-menu 1 Case #WM_RBUTTONDOWN DisplayPopupMenu(1, WindowID(1)) EndSelect ; Listen for "TaskbarCreated" broadcast to be sent to all windows if the taskbar is recreated then... ; Recreate our tray icon including the tool tip... Select uMsg Case TaskbarRestart AddSysTrayIcon(1, WindowID(1), SetImage(Num1)) SysTrayIconToolTip(1, "You are hovering over icon 1") EndSelect ProcedureReturn #PB_ProcessPureBasicEvents EndProcedure ; Icon Number 2 (clicking left mouse button manually cycles through the icons one at a time) Procedure WinCallback_Icon2(WindowID, uMsg, wParam, lParam) ; Cycle through "imageres.dll" icons. Windows 7 has 218 and Window 8 has 384!!! Select lParam Case #WM_LBUTTONDOWN Num2 = Num2 + 1 If Num2 > IconNum Num2 = 0 EndIf ChangeSysTrayIcon(2, SetImage(Num2)) ; Display popup-menu 2 Case #WM_RBUTTONDOWN DisplayPopupMenu(2, WindowID(1)) EndSelect ; Listen for "TaskbarCreated" broadcast to be sent to all windows if the taskbar is recreated then... ; Recreate our tray icon including the tool tip... Select uMsg Case TaskbarRestart AddSysTrayIcon(2, WindowID(2), SetImage(Num2)) SysTrayIconToolTip(2, "You are hovering over icon 2") EndSelect ProcedureReturn #PB_ProcessPureBasicEvents EndProcedure ; Create a thread to cycle through the icons, creating a thread allows us to continue using tray menu(s) Procedure ChangeIcon(void) ; Cycle through "imageres.dll" icons. Windows 7 has 218 and Window 8 has 384!!! Repeat Num1 = Num1 + 1 If Num1 > IconNum Num1 = 0 EndIf Sleep_(500) ChangeSysTrayIcon(1, SetImage(Num1)) Until ThreadID = #Null EndProcedure Ted. Animated Tray Icon.zip

Teddy Rogers

Teddy Rogers

Sign in to follow this  
×