NSIS plugin "nsScreenshot" does not work on Windows NT 6.x

I added a code that was published 3 years later than the original plugin, but it still returns an error ...

The direct code is imho ... but still, I most likely will 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. 

Find ScreenToFile .

Thanks for any input. This plugin is vital for automating the creation of installer documentation.

+6
source share
3 answers

1. Problem with the base block of the NSIS plugin:

1.1. About the wrong line:

From your own response message, there was a problem using the ANSI version of NSIS. Since you used in your library code compiled in Delphi XE, where string , Char and PChar mapped to Unicode strings, you walked between setting the NSIS installation and your library with incorrect data.

1.2. Another kind of module of the main plugin:

I checked your slightly modified plug-in module NSIS.pas , and there are some problems that do not allow your plugin to work correctly. However, since I saw this unit, the first thing that occurred to me was the union of individual procedures and functions into a class. And this is what I did.

1.3. NSIS.pas v2.0:

Since you are currently using only 3 functions from the original main block in your code , I have simplified the class to only use these (and one extra to display the message box). So, here is the code for the modified plugin kernel module. I'm not a data processing specialist, so maybe the following code can be simplified, but it works, at least in Delphi XE2 and Delphi 2009, where I 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. Using a modified plug-in module:

As you can see, the NullsoftInstaller global variable is declared, which allows you to use a class in which I already used the functions that you used earlier. Using an instance of an object from this variable is simplified with initialization and completion sections when this instance of an object is created and assigned to this variable when the library is loaded and freed when the library is freed.

So, the only thing you need to do in your code is to use this global NullsoftInstaller variable as follows:

 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 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 window

Here is my attempt at a screenshot procedure, TakeScreenshot in code. An additional DropShadow parameter is DropShadow , which should contain a screenshot, including the window shadow, when Aero composition is enabled. However, I could not find a way to do this in a different way than placing a fake window behind the captured one. He has one big weakness; sometimes it happens that the fake window is not displayed completely when the capture is performed, therefore the screenshot of the current desktop around the captured window instead of the white fake window (until it is displayed) is behind. Therefore, setting DropShadow to True is now only at the experimental stage.

When DropShadow is False (screenshots without shadow), it works correctly. I assume that you made a mistake in the parameters due to the Unicode Delphi and 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. 
+7
source

GetDesktopWindow should probably be GetDesktopWindow() , but often you can (and should) use NULL rather than GetDesktopWindow (). In addition, one function uses GetDC and the other GetWindowDC ...

+3
source

After some searching, 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 inclusin with NSIS caused a crash in the BitBtl function, probably due to Aero and the associated DWM fog ...

In addition, there is a suggestion to use this feature. Not a jet plane ...

http://msdn.microsoft.com/en-us/library/dd162869.aspx

However, there are several problems:

  • The glass frame is drawn as transparent.
  • The file name from NSIS is converted to a slightly damaged widestring ...
  • Files can only be drawn by the color of the dialog background if you change pages (using nsdialogs and MUI2) ...
+3
source

Source: https://habr.com/ru/post/919315/


All Articles