NSIS Plugin "nsScreenshot" not working in Windows NT 6.x - delphi

Question

I added a code that was published 3 years later than original plugin, but it still returns error...
Code is straight forward imho ... but still I most likely miss some aspect ...
See this code:
{
nsScreenshot NSIS Plugin
(c) 2003: Leon Zandman (leon#wirwar.com)
Re-compiled by: Linards Liepins (linards.liepins#gmail.com)
Code by: http://www.delphitricks.com/source-code/forms/make_a_desktop_screenshot.html
(e) 2012.
}
library nsScreenshot;
uses
nsis in './nsis.pas',
Windows,
Jpeg,
graphics,
types,
SysUtils;
const
USER32 = 'user32.dll';
type
HWND = type LongWord;
{$EXTERNALSYM HWND}
HDC = type LongWord;
{$EXTERNALSYM HDC}
BOOL = LongBool;
{$EXTERNALSYM BOOL}
{$EXTERNALSYM GetDesktopWindow}
function GetDesktopWindow: HWND; stdcall; external USER32 name 'GetDesktopWindow';
{$EXTERNALSYM GetWindowDC}
function GetWindowDC(hWnd: HWND): HDC; stdcall; external USER32 name 'GetWindowDC';
{$EXTERNALSYM GetWindowRect}
function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; stdcall; external USER32 name 'GetWindowRect';
{$EXTERNALSYM ReleaseDC}
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; stdcall; external user32 name 'ReleaseDC';
function GetScreenshot(Filename: string; Hwnd: HWND; var Width: integer; var Height: integer): boolean; forward;
function ScreenShot(Bild: TBitMap; hWnd: HWND): boolean; forward;
function Grab_FullScreen(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
var
buf: array[0..1024] of char;
W,H: integer;
begin
Result := 0;
// set up global variables
Init(hwndParent,string_size,variables,stacktop);
// Get filename to save to
PopString;//(#buf);
// Get a full-screen screenshot
if GetScreenShot(buf,GetDesktopWindow,W,H) then begin
// Everything went just fine...
// Push image dimensions onto stack
PushString(PChar(IntToStr(H)));
PushString(PChar(IntToStr(W)));
// Push result onto stack
PushString(PChar('ok'));
Result := 1;
end else begin
// Something went wrong...
PushString(PChar('error'));
end;
end;
function Grab(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
var
buf: array[0..1024] of char;
grabWnd: HWND;
Filename: string;
W,H: integer;
begin
Result := 0;
// set up global variables
Init(hwndParent,string_size,variables,stacktop);
try
// Get filename to save to
PopString;//(#buwf);
Filename := buf;
// Get window handle of window to grab
PopString;//(#buf);
grabWnd := StrToInt(buf);
except
PushString(PChar('error'));
exit;
end;
// Get screenshot of parent windows (NSIS)
if GetScreenShot(Filename,grabWnd,W,H) then begin
// Everything went just fine...
// Push image dimensions onto stack
PushString(PChar(IntToStr(H)));
PushString(PChar(IntToStr(W)));
// Push result onto stack
PushString(PChar('ok'));
Result := 1;
end else begin
// Something went wrong...
PushString(PChar('error'));
end;
end;
function GetScreenshot(Filename: string; Hwnd: HWND; var Width: integer; var Height: integer): boolean;
var
bmp: TBitmap;
begin
Result := false;
// Get screenshot
bmp := TBitmap.Create;
try
try
if ScreenShot(bmp,Hwnd) then begin
Width := bmp.Width;
Height := bmp.Height;
bmp.SaveToFile(Filename);
Result := true;
end;
except
// Catch exception and do nothing (function return value remains 'false')
end;
finally
bmp.Free;
end;
end;
function ScreenShot(Bild: TBitMap; hWnd: HWND): boolean;
var
c: TCanvas;
r, t: TRect;
h: THandle;
begin
Result := false;
c := TCanvas.Create;
c.Handle := GetWindowDC(GetDesktopWindow);
h := hWnd;
if h <> 0 then begin
GetWindowRect(h, t);
try
r := Rect(0, 0, t.Right - t.Left, t.Bottom - t.Top);
Bild.Width := t.Right - t.Left;
Bild.Height := t.Bottom - t.Top;
Bild.Canvas.CopyRect(r, c, t);
finally
ReleaseDC(0, c.Handle);
c.Free;
end;
Result := true;
end;
end;
function GetScreenToFile(FileName: string; Quality: Word; Percent: Word): boolean;
var
Bmp: TBitmap;
Jpg: TJpegImage;
begin
Bmp := TBitmap.Create;
Jpg := TJpegImage.Create;
try
Bmp.Width := GetDeviceCaps(GetDc(0), 8) * Percent div 100;
Bmp.Height := GetDeviceCaps(GetDc(0), 10) * Percent div 100;
SetStretchBltMode(Bmp.Canvas.Handle, HALFTONE);
StretchBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, GetDc(0), 0, 0, GetDeviceCaps(GetDc(0), 8), GetDeviceCaps(GetDc(0), 10), SRCCOPY);
Jpg.Assign(Bmp);
Jpg.CompressionQuality := Quality;
Jpg.SaveToFile(FileName);
finally
Jpg.free;
Bmp.free;
end;
end;
function ScreenToFile(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
var
buf: array[0..1024] of char;
grabWnd: HWND;
Filename: string;
W,H: integer;
begin
Result := 0;
Init(hwndParent,string_size,variables,stacktop);
try
PopString;
Filename := buf;
PopString;
grabWnd := StrToInt(buf);
except
PushString(PChar('error'));
exit;
end;
if GetScreenToFile(Filename,W,H) then
begin
PushString(PChar('ok'));
Result := 1;
end else
begin
PushString(PChar('error'));
end;
end;
//ScreenToFile('SHOT.JPG', 50, 70);
exports Grab_FullScreen,
Grab,
ScreenToFile;
begin
end.
Search for ScreenToFile.
Thanks for any input,. This plugin is vital for installer documentation generation automatization.

Answer 1

1. NSIS plugin core unit problem:
1.1. About the wrong string:
From your own answer post arised that you are using ANSI version of NSIS. Since you have used in your library code compiled in Delphi XE, where the string, Char and PChar are mapped to the Unicode strings, you were passing between NSIS setup application and your library wrong data.
1.2. Another view on core plugin unit:
I've checked your slightly modified plugin core unit NSIS.pas and there are some issues, that prevents your plugin to work properly. However, as I've seen this unit, the first what came to my mind, was to wrap the standalone procedures and functions into a class. And that's what I've done.
1.3. The NSIS.pas v2.0:
Since you've currently used only 3 functions from the original core unit in your code I've simplified the class for only using those (and one extra for message box showing). So here is the code of the modified plugin core unit. I'm not an expert for data manipulations, so maybe the following code can be simplified, but it works at least in Delphi XE2 and Delphi 2009, where I've tested it. Here is the code:
unit NSIS;
interface
uses
Windows, CommCtrl, SysUtils;
type
PParamStack = ^TParamStack;
TParamStack = record
Next: PParamStack;
Value: PAnsiChar;
end;
TNullsoftInstaller = class
private
FParent: HWND;
FParamSize: Integer;
FParameters: PAnsiChar;
FStackTop: ^PParamStack;
public
procedure Initialize(Parent: HWND; ParamSize: Integer; Parameters: PAnsiChar;
StackTop: Pointer);
procedure PushString(const Value: string = '');
function PopString: string;
function MessageDialog(const Text, Caption: string; Buttons: UINT): Integer;
end;
var
NullsoftInstaller: TNullsoftInstaller;
implementation
procedure TNullsoftInstaller.Initialize(Parent: HWND; ParamSize: Integer;
Parameters: PAnsiChar; StackTop: Pointer);
begin
FParent := Parent;
FParamSize := ParamSize;
FParameters := Parameters;
FStackTop := StackTop;
end;
procedure TNullsoftInstaller.PushString(const Value: string = '');
var
CurrParam: PParamStack;
begin
if Assigned(FStackTop) then
begin
CurrParam := PParamStack(GlobalAlloc(GPTR, SizeOf(TParamStack) + FParamSize));
StrLCopy(#CurrParam.Value, PAnsiChar(AnsiString(Value)), FParamSize);
CurrParam.Next := FStackTop^;
FStackTop^ := CurrParam;
end;
end;
function TNullsoftInstaller.PopString: string;
var
CurrParam: PParamStack;
begin
Result := '';
if Assigned(FStackTop) then
begin
CurrParam := FStackTop^;
Result := String(PAnsiChar(#CurrParam.Value));
FStackTop^ := CurrParam.Next;
GlobalFree(HGLOBAL(CurrParam));
end;
end;
function TNullsoftInstaller.MessageDialog(const Text, Caption: string;
Buttons: UINT): Integer;
begin
Result := MessageBox(FParent, PChar(Text), PChar(Caption), Buttons);
end;
initialization
NullsoftInstaller := TNullsoftInstaller.Create;
finalization
if Assigned(NullsoftInstaller) then
NullsoftInstaller.Free;
end.
1.4. Usage of the modified plugin core unit:
As you can see, there's the NullsoftInstaller global variable declared, which allows you to use the class where I've wrapped the functions you've been using before. The usage of the object instance from this variable is simplified with the initialization and finalization sections where this object instance is being created and assigned to this variable when the library is loaded and released when the library is freed.
So the only thing you need to do in your code is to use this NullsoftInstaller global variable like this way:
uses
NSIS;
function ScreenToFile(Parent: HWND; ParamSize: Integer; Parameters: PAnsiChar;
StackTop: Pointer): Integer; cdecl;
var
InputString: string;
begin
Result := 0;
// this is not necessary, if you keep the NullsoftInstaller object instance
// alive (and there's even no reason to free it, since this will be done in
// the finalization section when the library is unloaded), so the following
// statement has no meaning when you won't free the NullsoftInstaller
if not Assigned(NullsoftInstaller) then
NullsoftInstaller := TNullsoftInstaller.Create;
// this has the same meaning as the Init procedure in the original core unit
NullsoftInstaller.Initialize(Parent, ParamSize, Parameters, StackTop);
// this is the same as in the original, except that returns a native string
InputString := NullsoftInstaller.PopString;
NullsoftInstaller.MessageDialog(InputString, 'PopString Result', 0);
// and finally the PushString method, this is also the same as original and
// as well as the PopString supports native string for your Delphi version
NullsoftInstaller.PushString('ok');
end;
2. Screenshot of the Aero composited window
Here is my attempt of screenshot procedure, the TakeScreenshot in code. It takes an extra parameter DropShadow, which should take screenshot including window drop shadow, when the Aero composition is enabled. However I couldn't find a way how to do it in a different way than placing fake window behind the captured one. It has one big weakness; sometimes happens that the fake window isn't fully displayed when the capture is done, so it takes the screenshot of the current desktop around the captured window instead of the white fake window (not yet displayed) behind. So setting the DropShadow to True is now just in experimental stage.
When the DropShadow is False (screenshots without drop shadow) it works properly. My guess is that you were passing wrong parameters due to Unicode Delphi vs. ANSI NSIS problem described above.
library nsScreenshot;
uses
Windows, SysUtils, Types, Graphics, DwmApi, Forms, JPEG, NSIS;
procedure CalcCloseCrop(Bitmap: TBitmap; const BackColor: TColor;
out CropRect: TRect);
var
X: Integer;
Y: Integer;
Color: TColor;
Pixel: PRGBTriple;
RowClean: Boolean;
LastClean: Boolean;
begin
LastClean := False;
CropRect := Rect(Bitmap.Width, Bitmap.Height, 0, 0);
for Y := 0 to Bitmap.Height-1 do
begin
RowClean := True;
Pixel := Bitmap.ScanLine[Y];
for X := 0 to Bitmap.Width - 1 do
begin
Color := RGB(Pixel.rgbtRed, Pixel.rgbtGreen, Pixel.rgbtBlue);
if Color <> BackColor then
begin
RowClean := False;
if X < CropRect.Left then
CropRect.Left := X;
if X + 1 > CropRect.Right then
CropRect.Right := X + 1;
end;
Inc(Pixel);
end;
if not RowClean then
begin
if not LastClean then
begin
LastClean := True;
CropRect.Top := Y;
end;
if Y + 1 > CropRect.Bottom then
CropRect.Bottom := Y + 1;
end;
end;
with CropRect do
begin
if (Right < Left) or (Right = Left) or (Bottom < Top) or
(Bottom = Top) then
begin
if Left = Bitmap.Width then
Left := 0;
if Top = Bitmap.Height then
Top := 0;
if Right = 0 then
Right := Bitmap.Width;
if Bottom = 0 then
Bottom := Bitmap.Height;
end;
end;
end;
procedure TakeScreenshot(WindowHandle: HWND; const FileName: string;
DropShadow: Boolean);
var
R: TRect;
Form: TForm;
Bitmap: TBitmap;
Target: TBitmap;
DeviceContext: HDC;
DesktopHandle: HWND;
ExtendedFrame: Boolean;
const
CAPTUREBLT = $40000000;
begin
ExtendedFrame := False;
if DwmCompositionEnabled then
begin
DwmGetWindowAttribute(WindowHandle, DWMWA_EXTENDED_FRAME_BOUNDS, #R,
SizeOf(TRect));
if DropShadow then
begin
ExtendedFrame := True;
R.Left := R.Left - 30;
R.Top := R.Top - 30;
R.Right := R.Right + 30;
R.Bottom := R.Bottom + 30;
end;
end
else
GetWindowRect(WindowHandle, R);
SetForegroundWindow(WindowHandle);
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf24bit;
Bitmap.SetSize(R.Right - R.Left, R.Bottom - R.Top);
if ExtendedFrame then
begin
DesktopHandle := GetDesktopWindow;
DeviceContext := GetDC(GetDesktopWindow);
Form := TForm.Create(nil);
try
Form.Color := clWhite;
Form.BorderStyle := bsNone;
Form.AlphaBlend := True;
Form.AlphaBlendValue := 0;
ShowWindow(Form.Handle, SW_SHOWNOACTIVATE);
SetWindowPos(Form.Handle, WindowHandle, R.Left, R.Top,
R.Right - R.Left, R.Bottom - R.Top, SWP_NOACTIVATE);
Form.AlphaBlendValue := 255;
BitBlt(Bitmap.Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top,
DeviceContext, R.Left, R.Top, SRCCOPY or CAPTUREBLT);
finally
Form.Free;
ReleaseDC(DesktopHandle, DeviceContext);
end;
Target := TBitmap.Create;
try
CalcCloseCrop(Bitmap, clWhite, R);
Target.SetSize(R.Right - R.Left, R.Bottom - R.Top);
Target.Canvas.CopyRect(Rect(0, 0, R.Right - R.Left, R.Bottom - R.Top),
Bitmap.Canvas, R);
Target.SaveToFile(FileName);
finally
Target.Free;
end;
end
else
begin
DeviceContext := GetWindowDC(WindowHandle);
try
BitBlt(Bitmap.Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top,
DeviceContext, 0, 0, SRCCOPY or CAPTUREBLT);
finally
ReleaseDC(WindowHandle, DeviceContext);
end;
Bitmap.SaveToFile(FileName);
end;
finally
Bitmap.Free;
end;
end;
function ScreenToFile(Parent: HWND; ParamSize: Integer; Params: PAnsiChar;
StackTop: Pointer): Integer; cdecl;
var
I: Integer;
FileName: string;
DropShadow: Boolean;
Parameters: array[0..1] of string;
begin
Result := 0;
if not Assigned(NullsoftInstaller) then
NullsoftInstaller := TNullsoftInstaller.Create;
NullsoftInstaller.Initialize(Parent, ParamSize, Params, StackTop);
for I := 0 to High(Parameters) do
Parameters[I] := NullsoftInstaller.PopString;
FileName := Parameters[1];
if not DirectoryExists(ExtractFilePath(FileName)) or
not TryStrToBool(Parameters[0], DropShadow) then
begin
NullsoftInstaller.PushString('error');
NullsoftInstaller.PushString('Invalid parameters!');
Exit;
end;
try
TakeScreenshot(Parent, FileName, DropShadow);
NullsoftInstaller.PushString('ok');
Result := 1;
except
on E: Exception do
begin
NullsoftInstaller.PushString('error');
NullsoftInstaller.PushString(E.Message);
NullsoftInstaller.MessageDialog(E.Message, 'Error', 0);
end;
end;
end;
exports
ScreenToFile;
begin
end.

Answer 2

After some search I found the following code working from the following SO question:
How to take a screenshot of the Active Window in Delphi?
All other options in the inclusin with NSIS caused crash in BitBtl function, probobly because of Aero and its related DWM fog ...
Also, there is suggestion to use this function. Not jet tested...
http://msdn.microsoft.com/en-us/library/dd162869.aspx
Still, there few problems:
Glass frame is drawn as transparent one
File name from NSIS is converted to somewhat corrupted widestring ...
Files can be drawn just by dialog background color, if you change pages ( using nsdialogs and MUI2 ) ...

Answer 3

GetDesktopWindow should probably be GetDesktopWindow() but often you can (and should) use NULL and not GetDesktopWindow(). Also, one function uses GetDC and the other GetWindowDC...