NSIS插件"nsScreenshot"在Windows NT 6.x中无法正常工作 [英] NSIS Plugin "nsScreenshot" not working in Windows NT 6.x
本文介绍了NSIS插件"nsScreenshot"在Windows NT 6.x中无法正常工作的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我添加了一个比原始插件晚3年发布的代码，但是它仍然返回错误...
代码是直接的恕我直言……但我仍然很可能会错过某些方面……
查看此代码:
{
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.
搜索ScreenToFile.
感谢您的输入.该插件对于自动生成安装程序文档至关重要.
解决方案
1. NSIS插件核心单元问题:
1.1.关于错误的字符串:
从您自己的答案中可以看出，您正在使用NSIS的ANSI版本.由于您已在Delphi XE中编译的库代码中使用了string，Char和PChar映射到Unicode字符串的代码，因此您在NSIS设置应用程序和库错误数据之间传递.
1.2.核心插件单元的另一种观点:
我已经检查了您稍作修改的插件核心单元 NSIS.pas ，并且存在一些问题，这些问题会阻止您插件正常工作.但是，正如我看到的这个单元一样，我首先想到的是将独立的过程和函数包装到一个类中.这就是我所做的.
1.3. NSIS.pas v2.0:
由于您目前仅使用了 your code 中原始核心单元中的3个功能，该类仅用于那些类(还有一个用于显示消息框的类).因此，这是修改后的插件核心单元的代码.我不是数据处理专家，因此也许可以简化以下代码，但至少在我测试过的Delphi XE2和Delphi 2009中有效.这是代码:
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.修改后的插件核心单元的用法:
如您所见，声明了NullsoftInstaller全局变量，它使您可以使用包装了以前使用过的函数的类.通过初始化和终结处理节简化了此变量对对象实例的使用，在初始化和终结处理节中，当加载库并释放库时创建该对象实例并将其分配给该变量.
因此，您在代码中要做的唯一一件事就是像下面这样使用此NullsoftInstaller全局变量:
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. Aero复合窗口的屏幕截图
这是我尝试的截图过程，代码中的TakeScreenshot.启用了Aero合成后，它需要一个额外的参数DropShadow，该参数应获取包括窗口阴影在内的屏幕截图.但是，除了将伪造的窗口放在捕获的窗口后面之外，我找不到其他方法来做到这一点.它有一个很大的弱点.有时会发生这样的情况:在捕获完成后，假窗口没有完全显示出来，因此它将当前桌面的屏幕快照捕获到捕获的窗口周围，而不是后面的白色假窗口(尚未显示).因此，将DropShadow设置为True才刚刚处于实验阶段.
当DropShadow为False(没有投影的屏幕截图)时，它可以正常工作.我的猜测是由于上述Unicode Delphi与ANSI NSIS问题，您传递了错误的参数.
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.
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.
解决方案
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.
这篇关于NSIS插件"nsScreenshot"在Windows NT 6.x中无法正常工作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
