File "program cloner.bas"
Path: /program cloner/program cloner.bas
File size: 20.83 KB
MIME-type:
Charset: utf-8
#COMPILE EXE "program cloner.exe"
#DIM ALL
#RESOURCE "res\program cloner.pbr"
%DEBUG = 0 ' leave temporary files in place
'--------------------------------------------------------------------------------
' ** Includes **
'--------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "GdiPlus.inc"
#INCLUDE ONCE "GdipUtils.inc"
#INCLUDE ONCE "inc\SavePos.inc"
#INCLUDE ONCE "inc\xdata.inc"
#INCLUDE ONCE "inc\resource.inc"
#INCLUDE ONCE "inc\program cloner.inc"
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Functions & Subs **
'--------------------------------------------------------------------------------
FUNCTION PBMAIN()
LOCAL xd() AS ExeData
LOCAL a AS ASCIIZ * %MAX_PATH
LOCAL e AS STRING
LOCAL i AS LONG
' Initialize GDI+ library
LOCAL StartupInput AS GdiplusStartupInput
LOCAL token AS DWORD
StartupInput.GdiplusVersion = 1
GdiplusStartup token, StartupInput, BYVAL %NULL
' Discover ExeData
ParseExeData EXE.FULL$, xd()
IF ISFALSE ARRAYATTR(xd(),0) THEN ' No ExeData > 'Create New Clone' dialog
ShowExeList()
EXIT FUNCTION
END IF
' Packed with ExeData > 'Run As Clone' mode
DIM xd(0)
' Unpack background image to %LocalAppData%
i = FindExeData("IMG", xd())
IF i = 0 THEN
?"Illegal Cloner Data: <IMG> not found",%MB_ICONERROR,EXE.NAME$
EXIT FUNCTION
END IF
a = LocalAppData + EXE.NAME$ + ".png"
e = GetExeData(EXE.FULL$, xd(i))
SetFile e, (a)
e = UCODE$(a)
GdipLoadImageFromFile STRPTR(e), hDib
IF hDib = 0 THEN
?"Impossible to load embedded picture.",%MB_ICONWARNING,EXE.NAME$
EXIT FUNCTION
END IF
' Unpack taskbar icon to %LocalAppData%
i = FindExeData("ICO", xd())
IF i = 0 THEN
?"Illegal Cloner Data: <ICO> not found",%MB_ICONERROR,EXE.NAME$
EXIT FUNCTION
END IF
a = LocalAppData + EXE.NAME$ + ".ico"
e = GetExeData(EXE.FULL$, xd(i))
SetFile e, (a)
' Get program title
i = FindExeData("TXT", xd())
IF i = 0 THEN
?"Illegal Cloner Data: <TXT> not found",%MB_ICONERROR,EXE.NAME$
EXIT FUNCTION
END IF
cloneCaption = GetExeData(EXE.FULL$, xd(i))
' Launch Clone mode
ShowCloneMode(0)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
MACRO RefreshDialog
' Draw background image
GRAPHIC ATTACH CB.HNDL, 1001, REDRAW
GRAPHIC CLEAR BgndCol
GdipDrawImageRect hGdip(), hDib, 0, CaptionHeight + 5, iw, ih
DIALOG REDRAW CB.HNDL
END MACRO
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcCloneMode()
LOCAL pt AS POINTAPI
STATIC idEvent AS LONG
' Save/Restore dialog position
CB_SAVEPOS(EXE.NAME$)
' Start handling other CallBack Messages
SELECT CASE CB.MSG
'****************************************************************************************************************
' CallBack Message sent right before the dialog is displayed
'****************************************************************************************************************
CASE %WM_INITDIALOG
' Initialize Styles and Extended Styles of dialog
SetWindowLong CB.HNDL, %GWL_style, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME _
OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %WS_CAPTION
SetWindowLong CB.HNDL, %GWL_EXstyle, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT _
OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
' Minimize, Maximize, Resizable capabilities
IF ISTRUE(AllowMinimize) THEN SetWindowLong CB.HNDL, %GWL_style, GetWindowLong(CB.HNDL, %GWL_style) OR %WS_MINIMIZEBOX
IF ISTRUE(AllowMaximize) THEN SetWindowLong CB.HNDL, %GWL_style, GetWindowLong(CB.HNDL, %GWL_style) OR %WS_MAXIMIZEBOX
IF ISTRUE(AllowResize) THEN SetWindowLong CB.HNDL, %GWL_style, GetWindowLong(CB.HNDL, %GWL_style) OR %WS_THICKFRAME
' Set Always On Top
SetWindowPos CB.HNDL, IIF(OnTop, %HWND_TOPMOST, %HWND_NOTOPMOST), 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
' Set TaskBar (asynchronously)
IF ISTRUE(TaskBar) THEN
idEvent = SetTimer(CB.HNDL, %WM_USER+400, 10, BYVAL %NULL)
END IF
' Set Caption
IF ISFALSE(HasCaption) THEN
SetWindowLong CB.HNDL, %GWL_style, GetWindowLong(CB.HNDL, %GWL_style) XOR %WS_CAPTION
END IF
' Call RefreshDialog for the first time: create font, set FG & BG Colors
RefreshDialog
' Set Dialog Transparency / Transparent Font / Transparent Background
SetWindowLong CB.HNDL, %GWL_EXSTYLE, GetWindowLong(CB.HNDL, %GWL_EXstyle) OR %WS_EX_LAYERED
ShowWindow CB.HNDL, %SW_SHOWNORMAL
'****************************************************************************************************************
' Timer message send during initialization in order to display app in taskbar
'****************************************************************************************************************
CASE %WM_TIMER
KillTimer CB.HNDL, idEvent ' one-time event
ShowWindow CB.HNDL, %SW_HIDE
SetWindowLong CB.HNDL, %GWL_EXstyle, GetWindowLong(CB.HNDL, %GWL_EXstyle) XOR %WS_EX_TOOLWINDOW
SetWindowLong CB.HNDL, %GWL_EXstyle, GetWindowLong(CB.HNDL, %GWL_EXstyle) XOR %WS_EX_TOOLWINDOW
ShowWindow CB.HNDL, %SW_SHOWNORMAL
'****************************************************************************************************************
' CallBack Message sent when user right-clicks or presses 'Context' key
'****************************************************************************************************************
CASE %WM_ContextMenu
BEEP
'****************************************************************************************************************
' CallBack Message sent when user clicks on the dialog (or drags it by maintaining left-click pressed)
'****************************************************************************************************************
CASE %WM_LBUTTONDOWN
GetCursorPos pt
ScreenToClient CB.HNDL, pt
' Did user click in the caption bar ?
IF pt.Y <= 40 THEN
' The [X] button ?
IF pt.X >= iw - 45 THEN
AnimateWindow CB.HNDL, 200, %AW_HIDE OR %AW_CENTER ' -> Close the dialog with animation
PostMessage CB.HNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0
' The [_] button ?
ELSEIF pt.X >= iw - 3*45 AND _
pt.X <= iw - 2*45 THEN
AnimateWindow CB.HNDL, 200, %AW_HIDE OR %AW_VER_POSITIVE ' -> Minimize the dialog with animation
SendMessage CB.HNDL, %WM_SYSCOMMAND, %SC_MINIMIZE, 0
END IF
END IF
' Did user maintain left-click? -> force drag
IF CB.WPARAM = %MK_LBUTTON THEN SendMessage CB.HNDL, %WM_NCLBUTTONDOWN, %HTCaption, BYVAL %Null
'****************************************************************************************************************
' CallBack Message sent when computer wakes up from standby (sleep) or hibernate (deep sleep) mode
'****************************************************************************************************************
CASE %WM_PowerBroadcast
IF (CB.WPARAM = %PBT_APMRESUMESUSPEND OR _
CB.WPARAM = %PBT_APMRESUMESTANDBY OR _
CB.WPARAM = %PBT_APMRESUMECRITICAL) THEN
RefreshDialog
END IF
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowCloneMode(BYVAL hParent AS DWORD) AS LONG
LOCAL hDlg AS DWORD
LOCAL lRes AS LONG
' Get main background image dimensions
GdipGetImageHeight hDib, ih
GdipGetImageWidth hDib, iw
' Calculate dialog size based on image
dh = ih + CaptionHeight + 5
dw = iw
DIALOG NEW PIXELS, hParent, cloneCaption, 24, 0, iw-6, ih-CaptionHeight-8, TO hDlg
SetIcon hDlg, LocalAppData + EXE.NAME$ + ".ico"
OnTop = 0 ' dialog is always on top
HasCaption = 0 ' dialog has a caption (title bar) and a border
TaskBar = 1 ' dialog appears in the Task Bar
AllowMinimize = 0 ' icon "_" in caption (title bar) / "minimize" in context menu
AllowMaximize = 0 ' icon "[]" in caption (title bar) / "maximize" in context menu
AllowResize = 0 ' dialog can be resized by user
Transparency = 255 ' dialog transparency from 0 (invisible) to 255 (plain dialog)
BgndCol = RGB(224,223,227) ' dialog/graphic background color used for transparency
CONTROL ADD GRAPHIC, hDlg, 1001, "", 0, -CaptionHeight-5, dw, dh
GRAPHIC ATTACH hDlg, 1001, REDRAW
GRAPHIC COLOR %BLACK, BgndCol
GRAPHIC CLEAR
DIALOG SET COLOR hDlg, %BLACK, BgndCol
DIALOG SHOW MODAL hDlg, CALL ProcCloneMode TO lRes
FUNCTION = lRes
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcIcoPicker
SELECT CASE CB.MSG
CASE %WM_NOTIFY
IF CB.NMID = 1000 THEN ' LISTVIEW NOTIFICATIONS
LOCAL plvu AS LVUNION PTR
plvu = CB.LPARAM
IF CB.NMCODE = %LVN_ITEMCHANGED THEN ' NEW USER SELECTION
CONTROL ENABLE CB.HNDL, %IDOK
ELSEIF @pLVU.NMHDR.Code = %NM_DBLCLK THEN ' DOUBLE-CLICK
DIALOG POST CB.HNDL, %WM_COMMAND, _
MAKDWD(%IDOK,1), 0
END IF
END IF
CASE %WM_COMMAND
IF CB.CTL = %IDOK THEN ' CLICK ON OK BUTTON
LOCAL i AS LONG
LISTVIEW GET SELECT CB.HNDL, 1000 TO i
CONTROL GET TEXT CB.HNDL, 999 TO cloneCaption
DIALOG END CB.HNDL, i
END IF
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION ShowIcoPicker(BYVAL hParent AS DWORD, BYVAL icoExe AS STRING, BYVAL caption AS STRING) AS LONG
LOCAL hDlg AS DWORD
LOCAL hImageList AS DWORD
LOCAL hIcon AS DWORD
LOCAL tIcons AS LONG
LOCAL cIcons AS LONG
LOCAL lvCount AS LONG
LOCAL iResults AS LONG
DIALOG NEW PIXELS, hParent, "Program Settings", -5, 0, 400, 175, %WS_SYSMENU, TO hDlg
CONTROL ADD LABEL, hDlg, 998, "Clone title:", 8, 10, 60, 20
CONTROL ADD TEXTBOX, hDlg, 999, caption, 68, 8, 322, 20
CONTROL ADD LABEL, hDlg, 998, "Clone icon: (select one)", 8, 40, 120, 20
CONTROL ADD LISTVIEW, hDlg, 1000, "", 10, 60, 380, 74, %LVS_ICON OR %LVS_AUTOARRANGE _
OR %LVS_ALIGNLEFT OR %LVS_NOLABELWRAP OR %LVS_SINGLESEL, %WS_EX_STATICEDGE
LISTVIEW INSERT COLUMN hDlg, 1000, 1, "icon", 32, 0
LISTVIEW INSERT COLUMN hDlg, 1000, 2, "icon", 32, 0
CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 310, 145, 80, 20
CONTROL DISABLE hDlg, %IDOK
IMAGELIST NEW ICON 32, 32, 24, 6 TO hImageList
tIcons = ExtractIcon(BYVAL 0, (icoExe), -1)
FOR cIcons = 0 TO tIcons -1
hIcon = ExtractIcon(BYVAL 0, (icoExe), cIcons)
LISTVIEW SET IMAGELIST hDlg, 1000, hImageList, 0 ' %LVSIL_NORMAL
IMAGELIST ADD ICON hImageList, hIcon TO iResults
LISTVIEW INSERT ITEM hDlg, 1000, cIcons + 1, cIcons + 1, FORMAT$(cIcons)
DestroyIcon hIcon
NEXT cIcons
lvCount = tIcons
DIALOG SHOW MODAL hDlg CALL ProcIcoPicker TO iResults
FUNCTION = iResults
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
MACRO TempFile(extension) = LocalAppData + xname + "." + extension
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcExeList
LOCAL EncoderClsid AS GUID
LOCAL xname, xout AS STRING
LOCAL xpath, e AS STRING
LOCAL hWnd, pid AS DWORD
LOCAL hBmp, hDC AS DWORD
LOCAL i, w, h AS LONG
IF CB.MSG = %WM_COMMAND THEN
SELECT CASE AS LONG CB.CTL
CASE 999 ' CLICK ON REFRESH BUTTON > UPDATE LISTBOX
PopulateExe CB.HNDL, 1001
CASE 1001 ' DOUBLE-CLICK ON LISTBOX
IF CB.CTLMSG = %LBN_SELCHANGE THEN
CONTROL ENABLE CB.HNDL, %IDOK
ELSEIF CB.CTLMSG = %LBN_DBLCLK THEN ' > SIMULATE OK BUTTON
DIALOG POST CB.HNDL, %WM_COMMAND, MAKDWD(%IDOK,1), 0
END IF
CASE %IDOK ' CLICK ON OK BUTTON > CLONE
LISTBOX GET SELECT CB.HNDL, 1001 TO i
IF i = 0 THEN EXIT FUNCTION
LISTBOX GET TEXT CB.HNDL, 1001, i TO e
LISTBOX GET USER CB.HNDL, 1001, i TO hWnd
' Get dialog handle, process ID & full path to the exe to be cloned
GetWindowThreadProcessId(hWnd, pid)
xname = TRIM$(MID$(e, INSTR(e, "]") + 1))
xpath = GetPathNameFromPid(pid)
' Ask user to specify clone caption & icon
i = ShowIcoPicker(CB.HNDL, xpath, xname)
IF i = 0 THEN EXIT FUNCTION
' Ask user where to save the clone
MKDIR EXE.PATH$ + "Clones\"
DISPLAY SAVEFILE CB.HNDL, -50, -50, _
EXE.NAME$, EXE.PATH$ + "Clones\", _
"Executable" + CHR$(0) + "*.exe" + CHR$(0), _
MID$(e, 2, INSTR(e,"]")-2), "exe", _
%OFN_PATHMUSTEXIST OR %OFN_OVERWRITEPROMPT _
TO xout
IF xout = "" THEN EXIT FUNCTION
xname = LEFT$(MID$(xout, INSTR(-1, xout, "\") + 1), -4)
' Extract the icon from the original exe
ExtractExeIcon xpath, i, TempFile("ico")
' Dump the clone caption to a text file
SetFile cloneCaption, TempFile("txt")
' Take a screenshot of the exe dialog
DIALOG GET SIZE hWnd TO w, h
GRAPHIC BITMAP NEW w, h TO hBmp
GRAPHIC ATTACH hBmp, 0
GRAPHIC GET DC TO hDC
ShowWindow hWnd, 6 : ShowWindow hWnd, 1 : SLEEP 10
PrintWindow hWnd, hDC, 2 ' %PW_RENDERFULLCONTENT
' Save the screenshot to a BMP
GRAPHIC SAVE TempFile("bmp")
GRAPHIC DETACH
GRAPHIC BITMAP END
RemoveBlackBorders TempFile("bmp")
' Then convert the BMP to a PNG
e = UCODE$(TempFile("bmp"))
GdipLoadImageFromFile STRPTR(e), hBmp
EncoderClsid = GUID$(GdiPlusGetEncoderClsid("image/png"))
e = UCODE$(TempFile("png"))
GdipSaveImageToFile hBmp, STRPTR(e), _
EncoderClsid, BYVAL %NULL
GdipDisposeImage(hBmp)
' Now that we have all elements: build the cloned exe!
e = GetFile(EXE.FULL$)
e = AddExeData(e, "IMG", GetFile(TempFile("png")))
e = AddExeData(e, "ICO", GetFile(TempFile("ico")))
e = AddExeData(e, "TXT", GetFile(TempFile("txt")))
SetFile e, xout
' Clean-up!
IF ISFALSE %DEBUG THEN
SLEEP 100
KILL TempFile("bmp")
KILL TempFile("png")
KILL TempFile("ico")
KILL TempFile("txt")
END IF
' Show the clone in Windows Explorer
ShellExecute %NULL, "open", "explorer.exe" + $NUL, _
"/select," + $DQ + xout + $DQ + $NUL, $NUL, %SW_SHOW
CASE %IDCANCEL ' CLICK ON CANCEL BUTTON
DIALOG END CB.HNDL
EXIT FUNCTION
END SELECT
END IF
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB PopulateExe(BYVAL hDlg AS DWORD, BYVAL lID AS LONG)
LOCAL wList() AS WindowList
LOCAL i, j, iResult, iCount AS LONG
LOCAL szClass, szText AS ASCIIZ * %MAX_PATH
LOCAL xPath, xText, xClass AS STRING
LOCAL pid AS DWORD
LISTBOX RESET hDlg, lID
EnumWindows(CODEPTR(ParentCallback), BYVAL VARPTR(wList())) ' Retrieve top level window names
REDIM PRESERVE wList(UBOUND(wList))
FOR i = 0 TO UBOUND(wList)
iResult = GetWindowRect(wList(i).hwnd, wList(i).R) 'save bounding dimensions
iResult = GetClassName(wList(i).hwnd, szClass, SIZEOF(szClass))
iResult = GetWindowText(wList(i).hwnd, szText, SIZEOF(szText))
IF UCASE$(szClass) <> "" AND _
UCASE$(szClass) <> "EDGEUIINPUTTOPWNDCLASS" AND _
UCASE$(szClass) <> "PROGMAN" AND _
wList(i).R.nLeft >= 0 AND _
wList(i).R.nTop >= 0 AND _
wList(i).R.nRight >= 0 AND _
wList(i).R.nBottom >= 0 AND _
ISFALSE(wList(i).R.nLeft = 0 AND wList(i).R.nTop = 0 AND wList(i).R.nRight = 0 AND wList(i).R.nBottom = 0) AND _
ISFALSE(wList(i).R.nLeft = 1 AND wList(i).R.nTop = 1 AND wList(i).R.nRight = 1 AND wList(i).R.nBottom = 1) AND _
wList(i).PARENT = 1 AND _
IsWindowVisible(wList(i).hwnd) = 1 THEN
' Do some filtering
xClass = UCASE$(szClass)
IF xClass = "APPLICATIONFRAMEWINDOW" THEN
GOTO PassOver01
ELSEIF INSTR(xClass, "WINDOWS.UI") > 0 THEN
GOTO PassOver01
ELSEIF xClass = "SHELL_TRAYWND" THEN
IF TRIM$(szText) = "" THEN GOTO PassOver01
ELSEIF xClass = "WORKERW" THEN
IF TRIM$(szText) = "" THEN GOTO PassOver01
ELSEIF xClass = "SHELL_TRAYWND" THEN
IF TRIM$(szText) = "" THEN GOTO PassOver01
ELSEIF xClass = "QWIDGET" THEN
IF UCASE$(TRIM$(szText)) <> "GOOGLE EARTH" THEN GOTO PassOver01
END IF
IF TRIM$(szText) = "" THEN GOTO PassOver01
' Add process to the listbox !
GetWindowThreadProcessId(wList(i).hwnd, pid)
xPath = GetPathNameFromPid(pid)
xText = MID$(xPath, INSTR(-1, xPath, "\") + 1)
xText = "[" + xText + "] " + szText
' j = INSTR(xText, " -")
' IF j > 0 THEN xText = LEFT$(xText, j-1)
LISTBOX ADD hDlg, lID, xText
LISTBOX GET COUNT hDlg, lID TO iCount
LISTBOX SET USER hDlg, lID, iCount, wList(i).hwnd
END IF
PassOver01:
NEXT i
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB ShowExeList()
LOCAL hD AS DWORD
DIALOG NEW 0, EXE.NAME$,,, 262, 129, _
%DS_MODALFRAME OR %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU, TO hD
DIALOG SET ICON hD, "ICO1"
CONTROL ADD LABEL, hD, 1000, "Select a running program to clone it:", _
5, 4, 160, 10
CONTROL ADD LISTBOX, hD, 1001, , 5, 15, 250, 100, _
%LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL _
OR %LBS_USETABSTOPS OR %LBS_WANTKEYBOARDINPUT, _
%WS_EX_CLIENTEDGE
CONTROL ADD BUTTON, hD, %IDCANCEL, "Cancel", -10, -10, 0, 0
CONTROL ADD BUTTON, hD, 999, "Refresh", 140, 110, 55, 15
CONTROL ADD BUTTON, hD, %IDOK, "Clone it!", 200, 110, 55, 15
CONTROL DISABLE hD, %IDOK
PopulateExe hD, 1001
DIALOG SHOW MODAL hD, CALL ProcExeList
END SUB
'--------------------------------------------------------------------------------