BSOne.SFC/Tocsg.Module/PrintMark/EXE_PrintMark/DPtrMkMain.pas

502 lines
13 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit DPtrMkMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, GlobalDefine,
Tocsg.CommonData, Vcl.ExtCtrls, Vcl.Buttons, Tocsg.Win32, Tocsg.Process,
Tocsg.Controls, Tocsg.Printer;
type
TInstallPrintHook = function: Integer; stdcall;
TUninstallPrintHook = function: Integer; stdcall;
TDlgPtrMkMain = class(TForm)
btnHook: TButton;
Button1: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
edText: TEdit;
edFontSize: TEdit;
edLineCnt: TEdit;
btnSet: TButton;
tBlockUWP: TTimer;
Label5: TLabel;
Label4: TLabel;
edImgPath: TEdit;
btnImgPath: TSpeedButton;
mmRecentDoc: TMemo;
btnFreeModule: TButton;
GroupBox2: TGroupBox;
mmTgApp: TMemo;
chEtcPrintBlock: TCheckBox;
procedure btnHookClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btnSetClick(Sender: TObject);
procedure btnFreeModuleClick(Sender: TObject);
procedure tBlockUWPTimer(Sender: TObject);
private
{ Private declarations }
bActive_: Boolean;
SharedData_: TTgFileMapping<TSharedData>;
sDllPath_: String;
bIsWow64_: Boolean;
MgCtrls_: TManagerInputControlsData;
TgAppList_: TStringList;
ThdAppMon_: TThdProcessWatch;
ThdPrinter_: TTgPrtSpoolWatch;
procedure OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
procedure OnPtrJobNotify(Sender: TThdPrtSpoolWatch; Job: TPrtJobInfo);
function StartHookWatch: Boolean;
function StopHookWatch: Boolean;
function SetSharedData(bActive: Boolean): Boolean;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_CATCH_PRINT(var msg: TMessage); Message WM_CATCH_PRINT;
end;
var
DlgPtrMkMain: TDlgPtrMkMain;
implementation
uses
Tocsg.Path, Tocsg.Safe, Vcl.Imaging.pngimage, Tocsg.WinInfo, Tocsg.Network,
Tocsg.Shell, Tocsg.Param, Winapi.TlHelp32, Tocsg.Exception,
Tocsg.User32, Tocsg.Strings, Tocsg.WndUtil, Tocsg.Trace, Winapi.WinSpool,
EM.GDIPAPI, Tocsg.Files;
{$R *.dfm}
Constructor TDlgPtrMkMain.Create(aOwner: TComponent);
var
param: TTgParam;
begin
Inherited Create(aOwner);
Guard(param, TTgParam.Create);
SharedData_ := TTgFileMapping<TSharedData>.Create(MAP_FILENAME_APIHOOK, SizeOf(TSharedData));
ASSERT(SharedData_.IsAvailable);
ZeroMemory(SharedData_.Data, SizeOf(SharedData_.Data));
ChangeWindowMessageFilter(WM_CATCH_PRINT, MSGFLT_ADD);
edText.Text := GetComName + '\' + GetAccount + ' : ' + GetHostIP;
sDllPath_ := GetRunExePathDir + DLL_APIHOOK;
bIsWow64_ := IsWow64;
bActive_ := false;
MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
MgCtrls_.RegInputCtrl(mmTgApp);
MgCtrls_.RegInputCtrl(chEtcPrintBlock);
MgCtrls_.RegInputCtrl(edText);
MgCtrls_.RegInputCtrl(edFontSize);
MgCtrls_.RegInputCtrl(edLineCnt);
MgCtrls_.Load;
TgAppList_ := TStringList.Create;
TgAppList_.CaseSensitive := false;
ThdAppMon_ := nil;
ThdPrinter_ := nil;
{$IFDEF DEBUG}
btnFreeModule.Enabled := true;
btnFreeModule.Visible := true;
{$ENDIF}
end;
Destructor TDlgPtrMkMain.Destroy;
begin
//{$IFDEF DEBUG}
// EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK);
//{$ENDIF}
StopHookWatch;
FreeAndNil(MgCtrls_);
FreeAndNil(TgAppList_);
Inherited;
if SharedData_ <> nil then
FreeAndNil(SharedData_);
end;
function TDlgPtrMkMain.SetSharedData(bActive: Boolean): Boolean;
begin
Result := false;
edText.Text := Trim(edText.Text);
edImgPath.Text := Trim(edImgPath.Text);
if edText.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD>͸<EFBFBD>ũ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edText.SetFocus;
exit;
end;
if edFontSize.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><>Ʈ<EFBFBD><C6AE> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edFontSize.SetFocus;
exit;
end;
if edLineCnt.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edLineCnt.SetFocus;
exit;
end;
with SharedData_ do
begin
bActive_ := bActive;
Data.llRcvWnd := Handle;
Data.bActive := bActive_;
Data.nLineCnt := StrToIntDef(Trim(edLineCnt.Text), 4);
Data.nFontSize := StrToIntDef(Trim(edFontSize.Text), 175);
// StrCopy(Data.simgPath, PWideChar(edImgPath.Text));
StrCopy(Data.sText, PWideChar(edText.Text));
StrCopy(Data.sLogPath, PWideChar(GetRunExePathDir + LOG_FILE));
end;
Result := true;
end;
procedure TDlgPtrMkMain.tBlockUWPTimer(Sender: TObject);
var
hTop, h: HWND;
begin
hTop := FindWindow('ApplicationFrameWindow', nil);
while hTop <> 0 do
begin
if GetWndClassName(hTop) = 'ApplicationFrameWindow' then
begin
h := FindWindowEx(hTop, 0, 'Windows.UI.Core.CoreWindow', 'PrintDialog');
if h <> 0 then
SendMessage(h, WM_CLOSE, 0, 0);
end;
hTop := GetWindow(hTop, GW_HWNDNEXT);
end;
end;
procedure TDlgPtrMkMain.btnHookClick(Sender: TObject);
begin
if not bActive_ then
begin
// if hHookDLL_ = 0 then
// begin
// if not LoadHookDLL then
// begin
// MessageBox(Handle, PChar('DLL<4C><4C> <20>ε<EFBFBD><CEB5>ϴ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
// exit;
// end;
// end;
DeleteFile(PChar(GetRunExePathDir + LOG_FILE));
DeleteDir('C:\Users\kkuzil\Desktop\ptrTest');
ForceDirectories('C:\Users\kkuzil\Desktop\ptrTest');
mmTgApp.Text := Trim(mmTgApp.Text);
if mmTgApp.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>α׷<CEB1><D7B7><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
mmTgApp.SetFocus;
exit;
end;
MgCtrls_.Save;
SetSharedData(true);
if not StartHookWatch then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߻<EFBFBD><DFBB>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD>ð<EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end else begin
SetSharedData(false);
StopHookWatch;
// if not FreeHookDLL then
// begin
// MessageBox(Handle, PChar('DLL<4C><4C> <20>ε带 <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
// exit;
// end;
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD>ð<EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
btnSet.Enabled := bActive_;
// if chEtcPrintBlock.Checked then
// tBlockUWP.Enabled := bActive_;
GroupBox2.Enabled := not btnSet.Enabled;
if btnSet.Enabled then
btnHook.Caption := '<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>'
else
btnHook.Caption := '<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
Application.ProcessMessages;
end;
procedure TDlgPtrMkMain.btnSetClick(Sender: TObject);
begin
SetSharedData(bActive_);
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgPtrMkMain.OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
begin
case aKind of
pwkUnknown : {$IFDEF DEBUG} ASSERT(false) {$ENDIF};
pwkInit,
pwkExecute :
begin
if TgAppList_.IndexOf(pEnt.sPName) = -1 then
exit;
if InjectModule(pEnt.dwPid, sDllPath_, @bIsWow64_) then
begin
TTgTrace.T('InjectModule() .. PName="%s"', [pEnt.sPName]);
end else begin
{$IFDEF WIN64}
var sExe32: String := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sExe32) then
ExecutePath(sExe32, Format('-hook %d', [pEnt.dwPid]));
{$ENDIF}
TTgTrace.T('Fail .. InjectModule() .. PName="%s"', [pEnt.sPName]);
end;
end;
pwkTerminated : ;
end;
end;
procedure TDlgPtrMkMain.OnPtrJobNotify(Sender: TThdPrtSpoolWatch; Job: TPrtJobInfo);
var
sChk: String;
begin
if Job.WorkEnd then
exit;
if Job.PrinterName = '' then
exit;
if not Job.IsCustomPause and Job.IsSpooling then
begin
Job.PausePrtJob;
exit;
end;
if Job.IsCustomPause then
begin
sChk := SharedData_.Data.sCurDocName;
ZeroMemory(@SharedData_.Data.sCurDocName, 1024);
if sChk <> Job.Document then
begin
Job.SetPrtJob(JOB_CONTROL_CANCEL);
Job.SetPrtJob(JOB_CONTROL_DELETE);
ExecutePath(GetRunExePath, '-ptrblockmsg');
end else
Job.ResumePrtJob;
Job.WorkEnd := true;
end;
end;
function TDlgPtrMkMain.StartHookWatch: Boolean;
begin
Result := false;
if ThdAppMon_ = nil then
begin
try
EjectModuleFromPath(sDllPath_);
SplitString(mmTgApp.Text, '|', TgAppList_);
if chEtcPrintBlock.Checked then
begin
ThdPrinter_ := TTgPrtSpoolWatch.Create(true);
ThdPrinter_.OnPrtNotificationEvent := OnPtrJobNotify;
ThdPrinter_.StartWatch;
end;
ThdAppMon_ := TThdProcessWatch.Create;
ThdAppMon_.OnProcessWatchNotify := OnAppNotify;
ThdAppMon_.StartThread;
bActive_ := true;
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StartHookWatch()');
end;
end;
end;
function TDlgPtrMkMain.StopHookWatch: Boolean;
begin
Result := false;
if ThdAppMon_ <> nil then
begin
try
SetSharedData(false);
{$IFDEF WIN64}
var sExe32: String := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sExe32) then
ExecutePath(sExe32, '-clearhook');
{$ENDIF}
ThdAppMon_.OnProcessWatchNotify := nil;
FreeAndNil(ThdAppMon_);
if ThdPrinter_ <> nil then
begin
ThdPrinter_.OnPrtNotificationEvent := nil;
FreeAndNil(ThdPrinter_);
end;
TgAppList_.Clear;
EjectModuleFromPath(sDllPath_);
Sleep(500);
EjectModuleFromPath(sDllPath_);
bActive_ := false;
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StopHookWatch()');
end;
end;
end;
procedure TDlgPtrMkMain.Button1Click(Sender: TObject);
const
WORD_GAP = ' ';
var
cv, cc: TCanvas;
nW, nH, nX, nGapH, nRepeat: Integer;
bmp, bmp1: TBitmap;
bf: BLENDFUNCTION;
hbmp: HBITMAP;
png: TPngImage;
sOut: String;
pen: HPEN;
i: Integer;
begin
nW := Width; // GetDeviceCaps(cv.Handle, HORZRES);
nH := Height; // GetDeviceCaps(cv.Handle, VERTRES);
Guard(bmp, TBitmap.Create);
Guard(bmp1, TBitmap.Create);
Guard(cv, TCanvas.Create);
Guard(cc, TCanvas.Create);
cv.Handle := GetWindowDC(Handle);
cc.Handle := cv.Handle;// CreateCompatibleDC(cv.Handle);
hbmp := CreateCompatibleBitmap(cv.Handle, nW, nH);
SelectObject(cc.Handle, hbmp);
Guard(png, TPngImage.Create);
png.LoadFromFile('C:\taskToCSG\Tocsg.Module\PrintMark\OUT_Debug - Win32\jIns.prop.png');
bmp1.Width := png.Width;
bmp1.Height := png.Height;
bmp1.Assign(png);
StretchBlt(cc.Handle, 0, 0, nW, nH, bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height, SRCCOPY);
pen := CreatePen(PS_SOLID, 4, RGB(255, 0, 0));
SelectObject(cc.Handle, pen);
sOut := '<27>̰<EFBFBD><CCB0><EFBFBD> <20>׽<EFBFBD>Ʈ <20>Դϴ<D4B4>. <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
SetBkMode(cc.Handle, TRANSPARENT);
cc.Font.Size := 20;
cc.Font.Color := clGray;
cc.Font.Style := cc.Font.Style + [fsBold];
cc.Font.Orientation := 200;
nX := 0;
for i := 0 to 3 do
sOut := sOut + WORD_GAP + sOut;
i := 0;
nRepeat := 4;
nGapH := nH div (nRepeat - 1);
while i < nH + nGapH do
begin
cc.TextOut(nX, i, sOut);
Inc(i, nGapH);
// Dec(nX, 30);
end;
ZeroMemory(@bf, SizeOf(bf));
bf.AlphaFormat := 0; // <20>Ϲ<EFBFBD> <20><>Ʈ<EFBFBD><C6AE> 0, 32<33><32>Ʈ <20><>Ʈ<EFBFBD><C6AE> AC_SRC_ALPHA
bf.BlendFlags := 0; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 0
bf.BlendOp := AC_SRC_OVER; // AC_SRC_OVER
bf.SourceConstantAlpha := 50; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>(<28><><EFBFBD><EFBFBD> 0 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 255)
Winapi.Windows.AlphaBlend(cv.Handle, 0, 0, nW, nH, cc.Handle, 0, 0, nW, nH, bf);
// bmp.Width := nW;
// bmp.Height := nH;
//
// if BitBlt(bmp.Canvas.Handle,
// 0,
// 0,
// nW,
// nH,
// cv.Handle,
// 0,
// 0,
// SRCCOPY) then
// begin
// bmp.SaveToFile(GetRunExePathDir + 'test.bmp');
// end;
DeleteObject(pen);
DeleteObject(hbmp);
DeleteDC(cc.Handle);
DeleteDC(cv.Handle);
end;
procedure TDlgPtrMkMain.btnFreeModuleClick(Sender: TObject);
begin
// if bActive_ then
// begin
// MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD>Ʈ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>ٽ<EFBFBD> <20>õ<EFBFBD><C3B5><EFBFBD> <20>ֽʽÿ<CABD>.'),
// PChar(Caption), MB_ICONWARNING or MB_OK);
// exit;
// end;
ShowMessage(IntToStr(EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK)));
end;
procedure TDlgPtrMkMain.process_WM_CATCH_PRINT(var msg: TMessage);
var
sPath: String;
InfoList: TStringList;
begin
try
mmRecentDoc.Clear;
Guard(InfoList, TStringList.Create);
SplitString(SharedData_.Data.sPtrInfo, '|', InfoList);
// sPath := GetRunExePathDir + TXT_RECENT_DOCINFO;
// if not FileExists(sPath) then
// exit;
//
// Guard(InfoList, TStringList.Create);
// InfoList.LoadFromFile(sPath, TEncoding.UTF8);
if InfoList.Count < 3 then
exit;
mmRecentDoc.Lines.Add('PName : ' + InfoList[0]);
// mmRecentDoc.Lines.Add('Title : ' + GetWindowCaption(GetForegroundWindow)); // InfoList[1]);
// mmRecentDoc.Lines.Add('Title : ' + InfoList[1]);
mmRecentDoc.Lines.Add('Path : ' + InfoList[2]);
except
end;
end;
end.