This commit is contained in:
mgkim 2025-12-30 16:11:42 +09:00
parent 49d948d7bc
commit 74834264bf
2236 changed files with 503264 additions and 0 deletions

View File

@ -0,0 +1,37 @@
[
uuid(8B449B0A-A530-4D5B-898E-AE28EB10C48E),
version(1.0),
helpstring("BS1OutlookAddIn Library")
]
library BS1OutlookAddIn
{
importlib("stdole2.tlb");
interface ICoBS1OutlookAddIn;
coclass CoBS1OutlookAddIn;
[
uuid(F4179AC9-E4FA-4636-B1FE-4C43B92B8951),
version(1.0),
helpstring("Dispatch interface for CoBS1OutlookAddIn Object"),
dual,
oleautomation
]
interface ICoBS1OutlookAddIn: IDispatch
{
};
[
uuid(03C44A04-9AB9-4FF1-AD5B-82FC52775AEF),
version(1.0),
helpstring("CoBS1OutlookAddIn Object")
]
coclass CoBS1OutlookAddIn
{
[default] interface ICoBS1OutlookAddIn;
};
};

Binary file not shown.

View File

@ -0,0 +1,312 @@
{*******************************************************}
{ }
{ BS1OutlookAddInClient }
{ }
{ Copyright (C) 2023 kku }
{ }
{*******************************************************}
unit BS1OutlookAddInClient;
interface
uses
Tocsg.ClientBase, System.SysUtils, System.Classes, Tocsg.Packet,
Winapi.Windows, Tocsg.Win32, Tocsg.Obj, System.Generics.Collections,
GlobalOutAddInDefine, ManagerPattern;
type
TBS1OutlookAddInClient = class(TTgClientBase)
private
dwExecuteTick_: DWORD;
bTerminated_: Boolean;
// CltMtx_: TTgMutex;
MailPo_: TOutlookAddInPo;
hRcvHwnd_: HWND;
MgPtn_: TManagerPattern;
protected
function GetConnected: Boolean; override;
procedure ConnectedEvent; override;
procedure DisconnectedEvent; override;
procedure ProcessRcvPacket(aRcv: IRcvPacket); override;
public
Constructor Create;
Destructor Destroy; override;
procedure SetPatternList(sPatternOpt: String; var aList: TPatternEntList);
procedure SetRuleToPtrnList(sKwdPtrn: String; var aList: TPatternEntList);
property MailPo: TOutlookAddInPo read MailPo_;
property RcvHwnd: HWND read hRcvHwnd_;
end;
implementation
uses
Tocsg.Exception, Tocsg.Path, Tocsg.WndUtil, Tocsg.Strings,
Tocsg.Process, Tocsg.Shell, superobject, Tocsg.Registry, Tocsg.Json,
Tocsg.Safe, CttSchDefine, GlobalDefine;
{ TBS1OutlookAddInClient }
Constructor TBS1OutlookAddInClient.Create;
begin
Inherited Create('', 0);
bTerminated_ := false;
dwExecuteTick_ := 0;
ZeroMemory(@MailPo_, SizeOf(MailPo_));
// CltMtx_ := TTgMutex.Create('Global\SL20230214k');
//{$IFDEF DEBUG}
// ASSERT(CltMtx_.MutexState = msCreateOk);
//{$ELSE}
// if CltMtx_.MutexState <> msCreateOk then
// _Trace('Fail .. Create() .. CreateMutex()');
//{$ENDIF}
end;
Destructor TBS1OutlookAddInClient.Destroy;
begin
bTerminated_ := true;
if MgPtn_ <> nil then
FreeAndNil(MgPtn_);
// FreeAndNil(CltMtx_);
Inherited;
end;
function TBS1OutlookAddInClient.GetConnected: Boolean;
procedure TryConnection;
var
hFind, hIpc: HWND;
begin
hIpc := StrToInt64Def(GetRegValueAsString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'OutMon'), 0);
if hIpc <> 0 then
ConnectWnd(hIpc);
end;
var
sParam: String;
begin
Result := Inherited;
if not Result and not bTerminated_ and (W2W_ <> nil) then
begin
if (GetTickCount - dwExecuteTick_) > 10000 then // 최소 10초에 한번만 실행 되도록함
begin
dwExecuteTick_ := GetTickCount;
TryConnection;
end;
end;
end;
procedure TBS1OutlookAddInClient.ConnectedEvent;
begin
try
Inherited;
SetSendPauseState(false);
_Trace('Connected.');
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()');
end;
end;
procedure TBS1OutlookAddInClient.DisconnectedEvent;
begin
try
Inherited;
QSendPacket_.Clear;
ZeroMemory(@MailPo_, SizeOf(MailPo_));
if MgPtn_ <> nil then
FreeAndNil(MgPtn_);
_Trace('Disconnected');
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()');
end;
end;
// ManagerService.pas 에서 가져옴 23_0503 10:45:56 kku
procedure TBS1OutlookAddInClient.SetPatternList(sPatternOpt: String; var aList: TPatternEntList);
var
O: ISuperObject;
PtrnEnt, NewEnt: TPatternEnt;
StrList: TStringList;
i, nPos: Integer;
iter: TSuperObjectIter;
sName: String;
begin
try
aList.Clear;
if sPatternOpt = '' then
exit;
sPatternOpt := StringReplace(sPatternOpt, ';', '|', [rfReplaceAll]);
sPatternOpt := StringReplace(sPatternOpt, #13#10, '|', [rfReplaceAll]);
O := SO(sPatternOpt);
if O <> nil then
begin
if ObjectFindFirst(O, iter) then
begin
Repeat
if iter.key = 'scanoption' then
begin
Guard(StrList, TStringList.Create);
SplitString(O.S['scanoption'], '|', StrList);
for i := 0 to StrList.Count - 1 do
begin
PtrnEnt := MgPtn_.GetPatternEntByName(StrList[i]);
if PtrnEnt <> nil then
begin
NewEnt := TPatternEnt.Create(MgPtn_, nil);
NewEnt.AddName(MgPtn_.LangId, CttCodeToStr(StrList[i]));
NewEnt.PatternList.Add(PtrnEnt.GetSearchText);
aList.Add(NewEnt);
end;
end;
end else begin
sName := iter.key;
if sName.StartsWith('custom__') then
begin
Delete(sName, 1, 8);
// todo : 키워드, 패턴에 맞는 대응 필요?
nPos := Pos('__keyword', sName);
if nPos = 0 then
nPos := Pos('__pattern', sName);
if nPos > 0 then
begin
sName := Copy(sName, 1, nPos - 1);
PtrnEnt := aList.GetPtrnEntByName(sName);
if PtrnEnt = nil then
begin
PtrnEnt := TPatternEnt.Create(MgPtn_, nil);
PtrnEnt.AddName(MgPtn_.LangId, sName);
aList.Add(PtrnEnt);
end;
PtrnEnt.PatternList.Add(iter.val.AsString);
end;
end;
end;
Until not ObjectFindNext(iter);
ObjectFindClose(iter);
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. SetPatternList()');
end;
end;
procedure TBS1OutlookAddInClient.SetRuleToPtrnList(sKwdPtrn: String; var aList: TPatternEntList);
var
i: Integer;
PtrnEnt: TPatternEnt;
begin
aList.Clear;
if sKwdPtrn <> '' then
begin
var CusList: TStringList;
Guard(CusList, TStringList.Create);
SplitString(sKwdPtrn, '**', CusList);
var InfoList: TStringList;
Guard(InfoList, TStringList.Create);
for i := 0 to CusList.Count - 1 do
begin
SplitString(CusList[i], '::', InfoList);
if InfoList.Count > 4 then
begin
PtrnEnt := TPatternEnt.Create(MgPtn_, nil, nil, StrToIntDef(InfoList[2], 1));
PtrnEnt.RType := ManagerPattern.TRuleType(StrToIntDef(InfoList[3], 0));
PtrnEnt.IsAnd := InfoList[4] = 'T';
PtrnEnt.AddName(MgPtn_.LangId, InfoList[0]);
PtrnEnt.PatternList.Add(InfoList[1]);
aList.Add(PtrnEnt);
end;
end;
// var nPos: Integer := 0;
// var nCnt: Integer := 0;
// var sPtrnName: String := '';
// var sPtrnEnt: String := '';
// var sPtrnVal: String := '';
// for i := 0 to CusList.Count - 1 do
// begin
// sPtrnEnt := CusList[i];
// nPos := Pos('::', sPtrnEnt);
// if nPos > 0 then
// begin
// sPtrnName := Copy(sPtrnEnt, 1, nPos - 1);
// Delete(sPtrnEnt, 1, nPos + 1);
// nPos := Pos('|*|', sPtrnEnt);
// if nPos > 0 then
// begin
// sPtrnVal := Copy(sPtrnEnt, 1, nPos - 1);
// Delete(sPtrnEnt, 1, nPos + 2);
// nCnt := StrToIntDef(sPtrnEnt, 1);
// end else begin
// sPtrnVal := sPtrnEnt;
// nCnt := 1;
// end;
//
// PtrnEnt := TPatternEnt.Create(MgPtn_, nil, nil, nCnt);
// PtrnEnt.AddName(MgPtn_.LangId, sPtrnName);
// PtrnEnt.PatternList.Add(sPtrnVal);
// aList.Add(PtrnEnt);
// end;
// end;
end;
end;
procedure TBS1OutlookAddInClient.ProcessRcvPacket(aRcv: IRcvPacket);
procedure process_OAI_MAILSECU_POLICY;
var
StrList: TStringList;
i: Integer;
begin
MailPo_ := TTgJson.GetDataAsType<TOutlookAddInPo>(aRcv.O['PO']);
hRcvHwnd_ := aRcv.I['RcvHwnd'];
if (MailPo_.bMailCttSch or (MailPo_.AttachAB.Kind <> abkNone)) and
FileExists(MailPo_.sCttSchPtrnPath) then
begin
if MgPtn_ = nil then
begin
MgPtn_ := TManagerPattern.Create(MailPo_.sCttSchPtrnPath);
MgPtn_.LangId := 1; // 컨텐츠 필터 사용을 위함
end;
// if PatternEntList_ = nil then
// PatternEntList_ := TPatternEntList.Create(false);
//
// if MailPo_.sPatterns <> '' then
// begin
// if MailPo_.sPatterns.Contains('scanoption') then
// SetPatternList(MailPo_.sPatterns, PatternEntList_)
// else
// SetRuleToPtrnList(MailPo_.sPatterns, PatternEntList_);
// end else
// MgPtn_.GetUsePatternEnt(PatternEntList_);
end;
end;
begin
try
case aRcv.Command of
0 : ;
OAI_MAILSECU_POLICY : process_OAI_MAILSECU_POLICY;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [aRcv.Command]);
end;
end;
end.

View File

@ -0,0 +1,13 @@
object AddInModule: TAddInModule
Left = 0
Top = 0
ClientHeight = 243
ClientWidth = 304
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
TextHeight = 15
end

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,114 @@
unit BS1OutlookAddIn_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// $Rev: 98336 $
// File generated on 2023-03-03 ¿ÀÈÄ 12:51:49 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:\taskToCSG\eCrmHE\DLL_BS1OutlookAddIn\BS1OutlookAddIn (1)
// LIBID: {8B449B0A-A530-4D5B-898E-AE28EB10C48E}
// LCID: 0
// Helpfile:
// HelpString: BS1OutlookAddIn Library
// DepndLst:
// (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// SYS_KIND: SYS_WIN32
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
interface
uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
BS1OutlookAddInMajorVersion = 1;
BS1OutlookAddInMinorVersion = 0;
LIBID_BS1OutlookAddIn: TGUID = '{8B449B0A-A530-4D5B-898E-AE28EB10C48E}';
IID_ICoBS1OutlookAddIn: TGUID = '{F4179AC9-E4FA-4636-B1FE-4C43B92B8951}';
CLASS_CoBS1OutlookAddIn: TGUID = '{03C44A04-9AB9-4FF1-AD5B-82FC52775AEF}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
ICoBS1OutlookAddIn = interface;
ICoBS1OutlookAddInDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
CoBS1OutlookAddIn = ICoBS1OutlookAddIn;
// *********************************************************************//
// Interface: ICoBS1OutlookAddIn
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {F4179AC9-E4FA-4636-B1FE-4C43B92B8951}
// *********************************************************************//
ICoBS1OutlookAddIn = interface(IDispatch)
['{F4179AC9-E4FA-4636-B1FE-4C43B92B8951}']
end;
// *********************************************************************//
// DispIntf: ICoBS1OutlookAddInDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {F4179AC9-E4FA-4636-B1FE-4C43B92B8951}
// *********************************************************************//
ICoBS1OutlookAddInDisp = dispinterface
['{F4179AC9-E4FA-4636-B1FE-4C43B92B8951}']
end;
// *********************************************************************//
// The Class CoCoBS1OutlookAddIn provides a Create and CreateRemote method to
// create instances of the default interface ICoBS1OutlookAddIn exposed by
// the CoClass CoBS1OutlookAddIn. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoCoBS1OutlookAddIn = class
class function Create: ICoBS1OutlookAddIn;
class function CreateRemote(const MachineName: string): ICoBS1OutlookAddIn;
end;
implementation
uses System.Win.ComObj;
class function CoCoBS1OutlookAddIn.Create: ICoBS1OutlookAddIn;
begin
Result := CreateComObject(CLASS_CoBS1OutlookAddIn) as ICoBS1OutlookAddIn;
end;
class function CoCoBS1OutlookAddIn.CreateRemote(const MachineName: string): ICoBS1OutlookAddIn;
begin
Result := CreateRemoteComObject(MachineName, CLASS_CoBS1OutlookAddIn) as ICoBS1OutlookAddIn;
end;
end.

View File

@ -0,0 +1,26 @@
library Bs1Out;
uses
ComServ,
BS1OutlookAddIn_TLB in 'BS1OutlookAddIn_TLB.pas',
BS1OutlookAddIn_IMPL in 'BS1OutlookAddIn_IMPL.pas' {AddInModule: TAddInModule} {CoBS1OutlookAddIn: CoClass},
BS1OutlookAddInClient in 'BS1OutlookAddInClient.pas',
Define in 'Define.pas',
GlobalOutAddInDefine in 'GlobalOutAddInDefine.pas',
ManagerPattern in '..\..\Tocsg.Module\PatternManager\ManagerPattern.pas',
CttSchDefine in '..\..\Tocsg.Module\ContentSearch\LIB_Common\CttSchDefine.pas',
GlobalDefine in '..\LIB_Common\GlobalDefine.pas',
DefineHelper in '..\EXE_eCrmHeHelper\DefineHelper.pas';
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,19 @@
{*******************************************************}
{ }
{ Define }
{ }
{ Copyright (C) 2023 kku }
{ }
{*******************************************************}
unit Define;
interface
const
CLIENT_TYPE = 6;
CLIENT_VER = '1';
implementation
end.

View File

@ -0,0 +1,83 @@
{*******************************************************}
{ }
{ GlobalOutAddInDefine }
{ }
{ Copyright (C) 2023 kku }
{ }
{*******************************************************}
unit GlobalOutAddInDefine;
interface
uses
Winapi.Windows, GlobalDefine;
const
// 1.0 : 최초
// 1.1 : 제목, 본문 두곳에서 컨텐츠 필터 검출 옵션 추가, 새로운 패턴 적용 추가 23_1130 17:22:31 kku
VER_OUTLOOK_ADDIN = '1.1';
REG_BS1OutlookAddInKey = 'TypeLib\{8B449B0A-A530-4D5B-898E-AE28EB10C48E}';
OAI_MAILSECU_POLICY = 10;
OAI_MAILITEM_SEND_DATA = 11;
OAI_MAILITEM_RCV_DATA = 12;
DLL_ADDIN = 'Bs1out.dll';
DLL_ADDIN64 = 'Bs1out64.dll';
type
POutlookAddInPo = ^TOutlookAddInPo;
TMailCttSchProc = (mcspUnknown, mcspClear, mcspMask);
TMailCttSchPos = (mcsoBody, mcsoSubject, mcsoBoth);
TOutlookAddInPo = record
bCollectRcvMail,
bCollectSendMail,
bBlockAttSize,
bMailCttSch: Boolean;
MailCttSchProc: TMailCttSchProc;
MailCttSchPos: TMailCttSchPos;
nHitLimit: Integer;
sPatterns,
sRunDir,
sCttSchPtrnPath,
sCollectAttachPath: String;
// 첨부파일 별도 처리
AttachAB: TAttachBlockPolicy;
end;
procedure InstallOutlookAddin(sMdDir: String);
implementation
uses
Tocsg.Path, System.SysUtils, Tocsg.Process, Tocsg.Shell, Tocsg.Registry;
// 64환경에서만 사용하도록 작성됨, 32환경, APP에서 하려면 프로그램파일즈 설치 경로를 주의해야함 23_0504 14:41:55 kku
procedure InstallOutlookAddin(sMdDir: String);
var
sTemp: String;
begin
if sMdDir = '' then
sMdDir := GetRunExePathDir;
if DirectoryExists(sMdDir) and not ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
sTemp := GetProgramFilesDir;
if DirectoryExists(sTemp) then
begin
if DirectoryExists(sTemp[1] + ':\Program Files\Microsoft Office') then
sTemp := sMdDir + DLL_ADDIN64
else if DirectoryExists(sTemp[1] + ':\Program Files (x86)\Microsoft Office') then
sTemp := sMdDir + DLL_ADDIN
else sTemp := '';
if FileExists(sTemp) and (GetProcessPidByName('outlook.exe') = 0) then
ExecutePath_hide('regsvr32.exe', Format('/i /s "%s"', [sTemp]));
end;
end;
end;
end.

View File

@ -0,0 +1,524 @@
unit BS1Shell;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, ActiveX, Classes, ComObj, StdVcl, Winapi.ShlObj,
System.SysUtils;
type
// TBSOneShell = class(TComObject, IShellExtInit, IExplorerCommand)
TBSOneShell = class(TComObject, IShellExtInit, IContextMenu)
protected
{ IShellExtInit }
function IShellExtInit.Initialize = ShellInitialize; // 이름을 오버로딩해야함
// 이게 오버로딩된 함수
function ShellInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
{ IContextMenu }
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;
TBSOneShellFac = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
const
Class_BSOneShell: TGUID = '{FD43588C-B83F-4157-8D58-30A5BE32F46D}'; // '{0AAB383E-E7A7-4200-AB02-3FBCEEAF94DE}';
implementation
uses
System.Win.ComServ, Winapi.ShellAPI, superobject, System.Win.Registry, Tocsg.Safe, Tocsg.Registry, Tocsg.Path,
GlobalDefine,
Tocsg.Shell,
Vcl.Graphics, Vcl.Imaging.pngimage, System.IniFiles, Tocsg.Win32, Condition, Tocsg.Strings;
var
_SelFileList: TStringList = nil;
_SelTaskList: TStringList = nil;
_AipExtList: TStringList = nil;
_nCmdDrmEnc: Integer = -1;
_nCmdDrmDec: Integer = -1;
_nCmdPrtExp: Integer = -1;
_nCmdSc2Aip: Integer = -1;
_nCmdAip2Sc: Integer = -1;
_nCmdAipEnc: Integer = -1;
_nCmdAipDec: Integer = -1;
// 선택된 파일명을 받아오는 부분. Drag&Drop 형태로 받아온다는 걸 이해하자.
function TBSOneShell.ShellInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
Medium: TStgMedium;
FE: TFormatETC;
nCnt, nLen, i: Integer;
sPath: String;
begin
Result := S_FALSE;
if lpdobj = nil then
exit;
// 드롭된 파일명을 풀어냄
with FE do
begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lIndex := -1;
tymed := TYMED_HGLOBAL;
end;
if Failed(lpdobj.GetData(FE, Medium)) then
exit;
if _SelFileList <> nil then
begin
_SelFileList.Clear;
try
nCnt := DragQueryFile(Medium.hGlobal, DWORD(-1), nil, MAX_PATH);
for i := 0 to nCnt - 1 do
begin
nLen := DragQueryFile(Medium.hGlobal, i, nil, 0) + 1;
SetLength(sPath, nLen);
DragQueryFile(Medium.hGlobal, i, PChar(sPath), nLen);
if sPath[nLen] = #0 then
SetLength(sPath, nLen - 1);
// 파일만 추가
if FileExists(sPath) then
_SelFileList.Add(sPath);
// else if DirectoryExists(sPath) then
// _SelFileList.Add(sPath)
end;
finally
ReleaseStgMedium(Medium);
end;
if _SelFileList.Count > 0 then
Result := S_OK;
end;
end;
function MakeHResult(Severity, Facility: LongWord; Code: Word): HRESULT;
begin
Result := HRESULT((Severity shl 31) or (Facility shl 16) or Code);
end;
function TBSOneShell.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
function GetPngResFromFile(sPath: String; sId: String): TPngImage;
var
hInst: THandle;
res: TResourceStream;
ms: TMemoryStream;
begin
Result := nil;
if not FileExists(sPath) then
exit;
hInst := LoadLibraryEx(PChar(sPath), 0, LOAD_LIBRARY_AS_DATAFILE);
if hInst <> 0 then
begin
try
Guard(res, TResourceStream.Create(hInst, sId, 'raw'));
if res <> nil then
begin
Guard(ms, TMemoryStream.Create);
res.SaveToStream(ms);
ms.Position := 0;
Result := TPngImage.Create;
Result.LoadFromStream(ms);
// Result.SaveToFile('C:\Users\kku\Desktop\' + sId + '.ico');
end;
except
// ..
if Result <> nil then
FreeAndNil(Result);
end;
end;
FreeLibrary(hInst);
end;
var
hMenuTasks : Cardinal;
MenuInfo: TMenuItemInfo;
sPath,
sDrm1, sDrm2, sPrint: String;
png: TPngImage;
bmp: TBitmap;
nAddMenuCnt: Integer;
begin
Result := S_OK;
if (_SelFileList = nil) or (_SelFileList.Count = 0) then
exit;
if _SelTaskList = nil then
exit;
if (_AipExtList <> nil) and (_AipExtList.Count = 0) then
SplitString(AIP_EXTS, '|', _AipExtList);
// 더블클릭 제외 (일반적 실행)
if (uFlags and CMF_DEFAULTONLY) <> 0 then
exit;
nAddMenuCnt := 0;
// InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil); // SEPARATOR // 안먹힌다
if InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil) then
begin
Inc(indexMenu);
Inc(nAddMenuCnt);
end;
sPath := GetProgramFilesDir + DIR_HE + EXE_HE;
if not FileExists(sPath) then
sPath := 'C:\taskToCSG\eCrmHE\OUT_Release - Win64\eCrmHomeEdition.exe';
if MutexExists(MUTEX_SHELL_MIPENC) then
begin
if _AipExtList.IndexOf(GetFileExt(_SelFileList[0])) <> -1 then
begin
sDrm1 := '문서 암호화';
sDrm2 := '문서 암호화 해제';
var hSub: HMENU := 0;
var bAddSub: Boolean := false;
// if MutexExists(MUTEX_SHELL_DRMENC) then
begin
if hSub = 0 then
hSub := CreatePopupMenu;
if InsertMenu(hSub, 0, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, PChar(sDrm1)) then
begin
Guard(png, GetPngResFromFile(sPath, 'RS_DRMLOCK'));
if png <> nil then
begin
bmp := TBitmap.Create;
bmp.Assign(png);
// SetMenuItemBitmaps(hSub, 101, MF_BYPOSITION, bmp.Handle, bmp.Handle);
var mii: MENUITEMINFO;
ZeroMemory(@mii, SizeOf(mii));
mii.cbSize := SizeOf(mii);
mii.fMask := MIIM_BITMAP;
mii.hbmpItem := bmp.Handle;
// SetMenuItemBitmaps() 보다 SetMenuItemInfo() 권장됨 25_1217 10:35:37 kku
SetMenuItemInfo(hSub, idCmdFirst + nAddMenuCnt, false, mii);
end;
_nCmdAipEnc := nAddMenuCnt;
Inc(nAddMenuCnt);
bAddSub := true;
end;
end;
// 구분선
// AppendMenu(hSub, MF_SEPARATOR, 0, nil);
// AppendMenu(hSub, MF_STRING, 3004, '설정');
if MutexExists(MUTEX_SHELL_DRMDEC) then
begin
if hSub = 0 then
hSub := CreatePopupMenu;
if InsertMenu(hSub, 1, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, PChar(sDrm2)) then
begin
Guard(png, GetPngResFromFile(sPath, 'RS_DRMUNLOCK'));
if png <> nil then
begin
bmp := TBitmap.Create;
bmp.Assign(png);
// SetMenuItemBitmaps(hSub, 102, MF_BYPOSITION, bmp.Handle, bmp.Handle);
var mii: MENUITEMINFO;
ZeroMemory(@mii, SizeOf(mii));
mii.cbSize := SizeOf(mii);
mii.fMask := MIIM_BITMAP;
mii.hbmpItem := bmp.Handle;
// SetMenuItemBitmaps() 보다 SetMenuItemInfo() 권장됨 25_1217 10:35:37 kku
SetMenuItemInfo(hSub, idCmdFirst + nAddMenuCnt, false, mii);
end;
_nCmdAipDec := nAddMenuCnt;
Inc(nAddMenuCnt);
bAddSub := true;
end;
end;
if bAddSub then
begin
if InsertMenu(Menu, indexMenu, MF_BYPOSITION or MF_POPUP, hSub, PChar('문서 암호화/해제')) then
begin
Inc(indexMenu);
// Inc(nAddMenuCnt); // cmd id가 없는건 추가 갯수에 포함하면 안된다 25_1217 kku
end;
end;
end;
// CUSTOMER_TYPE := GetRegValueAsInteger(HKEY_CURRENT_USER, REG_HE, 'CT');
// case CUSTOMER_TYPE of
// CUSTOMER_HCA :
// begin
// if InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, 'SC-DRM → AIP') then
// begin
// Guard(png, GetPngResFromFile(sPath, 'RS_DRMLOCK'));
// if png <> nil then
// begin
// bmp := TBitmap.Create;
// bmp.Assign(png);
// SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Handle, bmp.Handle);
// end;
//
// _nCmdSc2Aip := nAddMenuCnt;
// Inc(indexMenu);
// Inc(nAddMenuCnt);
// end;
//
// if InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, 'AIP → SC-DRM') then
// begin
// Guard(png, GetPngResFromFile(sPath, 'RS_DRMLOCK'));
// if png <> nil then
// begin
// bmp := TBitmap.Create;
// bmp.Assign(png);
// SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Handle, bmp.Handle);
// end;
//
// _nCmdAip2Sc := nAddMenuCnt;
// Inc(indexMenu);
// Inc(nAddMenuCnt);
// end;
// end;
// end;
end else begin
if IsBS1Display then
begin
sDrm1 := 'BSOne으로 DRM 적용';
sDrm2 := 'BSOne으로 DRM 해제';
end else begin
sDrm1 := 'QS-eCRM으로 DRM 적용';
sDrm2 := 'QS-eCRM으로 DRM 해제';
end;
if MutexExists(MUTEX_SHELL_DRMENC) then
begin
if InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, PChar(sDrm1)) then
begin
Guard(png, GetPngResFromFile(sPath, 'RS_DRMLOCK'));
if png <> nil then
begin
bmp := TBitmap.Create;
bmp.Assign(png);
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Handle, bmp.Handle);
end;
_nCmdDrmEnc := nAddMenuCnt;
Inc(indexMenu);
Inc(nAddMenuCnt);
end;
end;
if MutexExists(MUTEX_SHELL_DRMDEC) then
begin
if InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, PChar(sDrm2)) then
begin
Guard(png, GetPngResFromFile(sPath, 'RS_DRMUNLOCK'));
if png <> nil then
begin
bmp := TBitmap.Create;
bmp.Assign(png);
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Handle, bmp.Handle);
end;
_nCmdDrmDec := nAddMenuCnt;
Inc(indexMenu);
Inc(nAddMenuCnt);
end;
end;
end;
if MutexExists(MUTEX_SHELL_EXPT_PRTWATER) then
begin
sPrint := '프린트 워터마크 예외신청';
if InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst + nAddMenuCnt, PChar(sPrint)) then
begin
Guard(png, GetPngResFromFile(sPath, 'RS_DRMUNLOCK'));
if png <> nil then
begin
bmp := TBitmap.Create;
bmp.Assign(png);
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, bmp.Handle, bmp.Handle);
end;
_nCmdPrtExp := nAddMenuCnt;
Inc(indexMenu);
Inc(nAddMenuCnt);
end;
end;
if InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil) then
begin
Inc(indexMenu);
Inc(nAddMenuCnt);
end;
// 메뉴 앞에 작은 아이콘 이미지 추가
//SetMenuItemBitmaps(Menu, 0, MF_BYPOSITION, bBitmap, bBitmap);
// 추가한 항목의 개수
Result := MakeHResult(SEVERITY_SUCCESS, 0, nAddMenuCnt);;
end;
function TBSOneShell.GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
var
nCnt: Integer;
begin
if idCmd = 0 then
begin
// if _SelFileList <> nil then
// nCnt := _SelFileList.Count
// else
// nCnt := 0;
//
// // 커서가 메뉴항목 위로 올라올 때 상태표시줄에 표시할 문자열 요청
// if uFlags = GCS_HELPTEXT then
// StrLCopy(pszName, LPSTR(Format('[%s] 목록에 추가될 항목 수 : %d', [APP_NAME, nCnt])), cchMax);
Result := NOERROR;
end else
Result := E_INVALIDARG;
end;
function TBSOneShell.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
sPgPath,
sTempPath: String;
exInfo: ShellExecuteInfo;
O, OA: ISuperObject;
ss: TStringStream;
i, nCmdOffset: Integer;
ini: TIniFile;
hMain: HWND;
begin
Result := E_INVALIDARG;
if HiWord(Integer(lpici.lpVerb)) <> 0 then
exit;
// 처음엔 메뉴 아이디 (dwCmd, idCmd) 인줄 알았는데 아니었다...
// 일반 메뉴든 서브 메뉴든 상관없이,
// 메뉴를 추가한 순서대로 인덱스 번호가 메겨지는것 같다... 0부터 시작.. 18_1127 23:08:35 kku
nCmdOffset := LoWord(NativeUInt(lpici.lpVerb));
if (_SelFileList = nil) or (_SelFileList.Count = 0) then
exit;
if _SelTaskList = nil then
exit;
sPgPath := GetProgramFilesDir + DIR_HE;
if not FileExists(sPgPath + EXE_HE) then
exit;
if not FileExists(sPgPath + INI_HE) then
exit;
begin
Guard(ini, TIniFile.Create(sPgPath + INI_HE));
hMain := StrToInt64Def(ini.ReadString('Config', 'MW', '0'), 0);
if hMain = 0 then
exit;
end;
OA := TSuperObject.Create(stArray);
for i := 0 to _SelFileList.Count - 1 do
OA.AsArray.Add(_SelFileList[i]);
O := SO;
if nCmdOffset = _nCmdDrmEnc then
O.I['Cmd'] := 1
else if nCmdOffset = _nCmdDrmDec then
O.I['Cmd'] := 2
else if nCmdOffset = _nCmdPrtExp then
O.I['Cmd'] := 3
else if nCmdOffset = _nCmdSc2Aip then
O.I['Cmd'] := 4
else if nCmdOffset = _nCmdAip2Sc then
O.I['Cmd'] := 5
else if nCmdOffset = _nCmdAipEnc then
O.I['Cmd'] := 6
else if nCmdOffset = _nCmdAipDec then
O.I['Cmd'] := 7;
O.O['Files'] := OA;
O.S['Dir'] := AnsiString(lpici.lpDirectory);
ss := TStringStream.Create(O.AsString, TEncoding.UTF8);
try
sTempPath := sPgPath[1] + ':\ProgramData\HE\Task\';
if ForceDirectories(sTempPath) then
begin
sTempPath := sTempPath + 'bs1.$shl';
if FileExists(sTempPath) then
DeleteFile(sTempPath);
ss.SaveToFile(sTempPath);
PostMessage(hMain, WM_REQUEST_DRM, 0, 0);
end;
finally
ss.Free;
end;
Result := S_OK;
end;
{ TBSOneShellFac }
procedure TBSOneShellFac.UpdateRegistry(Register: Boolean);
begin
if Register then
begin
inherited UpdateRegistry(Register);
// * : 전체 파일
// Directory : 디렉토리
// Drive : 드라이브
// Folder : 폴더
CreateRegKey('*\shellex\ContextMenuHandlers\BSOne', '', GUIDToString(Class_BSOneShell));
CreateRegKey('Directory\shellex\ContextMenuHandlers\BSOne', '', GUIDToString(Class_BSOneShell));
end else begin
DeleteRegKey('Directory\shellex\ContextMenuHandlers\BSOne');
DeleteRegKey('*\shellex\ContextMenuHandlers\BSOne');
inherited UpdateRegistry(Register);
end;
end;
initialization
_SelFileList := TStringList.Create;
_SelTaskList := TStringList.Create;
_AipExtList := TStringList.Create;
_AipExtList.CaseSensitive := false;
TBSOneShellFac.Create(ComServer, TBSOneShell, Class_BSOneShell,
'BSOneShell', 'BSOne', ciMultiInstance, tmApartment);
finalization
FreeAndNil(_AipExtList);
FreeAndNil(_SelTaskList);
FreeAndNil(_SelFileList);
end.

File diff suppressed because one or more lines are too long

View File

@ -0,0 +1,84 @@
library Bs1shl;
uses
ComServ,
Tocsg.Obj in '..\..\Tocsg.Lib\VCL\Tocsg.Obj.pas',
Tocsg.Trace in '..\..\Tocsg.Lib\VCL\Tocsg.Trace.pas',
Tocsg.Safe in '..\..\Tocsg.Lib\VCL\Tocsg.Safe.pas',
Tocsg.Path in '..\..\Tocsg.Lib\VCL\Tocsg.Path.pas',
Tocsg.Files in '..\..\Tocsg.Lib\VCL\Tocsg.Files.pas',
Tocsg.DateTime in '..\..\Tocsg.Lib\VCL\Tocsg.DateTime.pas',
Tocsg.Encrypt in '..\..\Tocsg.Lib\VCL\Tocsg.Encrypt.pas',
Tocsg.Thread in '..\..\Tocsg.Lib\VCL\Tocsg.Thread.pas',
Tocsg.Strings in '..\..\Tocsg.Lib\VCL\Tocsg.Strings.pas',
Tocsg.Hex in '..\..\Tocsg.Lib\VCL\Tocsg.Hex.pas',
Tocsg.Json in '..\..\Tocsg.Lib\VCL\Tocsg.Json.pas',
Tocsg.Packet in '..\..\Tocsg.Lib\VCL\CS\Tocsg.Packet.pas',
Tocsg.Win32 in '..\..\Tocsg.Lib\VCL\Tocsg.Win32.pas',
Tocsg.Process in '..\..\Tocsg.Lib\VCL\Tocsg.Process.pas',
Tocsg.WTS in '..\..\Tocsg.Lib\VCL\Tocsg.WTS.pas',
Tocsg.Kernel32 in '..\..\Tocsg.Lib\VCL\Tocsg.Kernel32.pas',
Tocsg.Shell in '..\..\Tocsg.Lib\VCL\Tocsg.Shell.pas',
Tocsg.Service in '..\..\Tocsg.Lib\VCL\Tocsg.Service.pas',
Tocsg.Registry in '..\..\Tocsg.Lib\VCL\Tocsg.Registry.pas',
Tocsg.FileInfo in '..\..\Tocsg.Lib\VCL\Tocsg.FileInfo.pas',
Tocsg.WndUtil in '..\..\Tocsg.Lib\VCL\Tocsg.WndUtil.pas',
Tocsg.WinInfo in '..\..\Tocsg.Lib\VCL\Tocsg.WinInfo.pas',
Tocsg.Exception in '..\..\Tocsg.Lib\VCL\Tocsg.Exception.pas',
Tocsg.Network in '..\..\Tocsg.Lib\VCL\Tocsg.Network.pas',
Tocsg.Driver in '..\..\Tocsg.Lib\VCL\Tocsg.Driver.pas',
Tocsg.Convert in '..\..\Tocsg.Lib\VCL\Tocsg.Convert.pas',
Tocsg.Disk in '..\..\Tocsg.Lib\VCL\Tocsg.Disk.pas',
Tocsg.WMI in '..\..\Tocsg.Lib\VCL\Tocsg.WMI.pas',
Tocsg.Printer in '..\..\Tocsg.Lib\VCL\Tocsg.Printer.pas',
Tocsg.PacketDefine in '..\..\Tocsg.Lib\VCL\CS\Tocsg.PacketDefine.pas',
Tocsg.Process.IPC in '..\..\Tocsg.Lib\VCL\Tocsg.Process.IPC.pas',
Tocsg.Param in '..\..\Tocsg.Lib\VCL\Tocsg.Param.pas',
Tocsg.DRM.Encrypt in '..\..\Tocsg.Module\TocsgDRM\LIB_Common\Tocsg.DRM.Encrypt.pas',
Tocsg.Binary in '..\..\Tocsg.Lib\VCL\Tocsg.Binary.pas',
Tocsg.Hash in '..\..\Tocsg.Lib\VCL\Tocsg.Hash.pas',
EM.Tocsg.hash in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.hash.pas',
EM.Tocsg.Sha1 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.Sha1.pas',
EM.MD5 in '..\..\Tocsg.Lib\VCL\EncLib\EM.MD5.pas',
EM.CRC32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.CRC32.pas',
EM.Tocsg.sha256 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.sha256.pas',
EM.GSStorage in '..\..\Tocsg.Lib\VCL\Other\EM.GSStorage.pas',
EM.WinOSVersion in '..\..\Tocsg.Lib\VCL\Other\EM.WinOSVersion.pas',
EM.winioctl in '..\..\Tocsg.Lib\VCL\Other\EM.winioctl.pas',
EM.WtsApi32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.WtsApi32.pas',
EM.nduWlanAPI in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanAPI.pas',
EM.nduCType in '..\..\Tocsg.Lib\VCL\Other\EM.nduCType.pas',
EM.nduL2cmn in '..\..\Tocsg.Lib\VCL\Other\EM.nduL2cmn.pas',
EM.nduWlanTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanTypes.pas',
EM.nduWinDot11 in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinDot11.pas',
EM.nduWinNT in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinNT.pas',
EM.nduEapTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduEapTypes.pas',
EM.nduNtDDNdis in '..\..\Tocsg.Lib\VCL\Other\EM.nduNtDDNdis.pas',
EM.WbemScripting_TLB in '..\..\Tocsg.Lib\VCL\Other\EM.WbemScripting_TLB.pas',
superobject in '..\..\Tocsg.Lib\VCL\SuperObject\superobject.pas',
aes_type in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_type.pas',
aes_cbc in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_cbc.pas',
BTypes in '..\..\Tocsg.Lib\VCL\EncLib\AES\BTypes.pas',
AES_Base in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Base.pas',
AES_Encr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Encr.pas',
AES_Decr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Decr.pas',
BS1Shell in 'BS1Shell.pas',
GlobalDefine in '..\LIB_Common\GlobalDefine.pas',
Condition in '..\LIB_Common\Condition.pas';
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer,
DllInstall;
{$R *.RES}
begin
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

Binary file not shown.

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,11 @@
unit Define;
interface
const
CLIENT_TYPE = 10001;
CLIENT_VER = '1';
implementation
end.

View File

@ -0,0 +1,174 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_Custom;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_Custom(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Tocsg.Trace, GlobalDefine, Tocsg.Strings, Tocsg.WinInfo,
Tocsg.Network;
function ProcessWartermark_Custom(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
CtrlOpt: TAppCtrlOpt;
r: TRect;
PWC: TPrtWaterCfg;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC;
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
nGapW := 19;
nGapH := 17;
end;
end else begin
// if gAppHook.Helper.bEndDocProc_ then
// begin
// if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
// nGapH := 70;
// end;
end;
// 기본 폰트 조절
// nDefDivFont을 10이라고 인식하기로함
if nW > nH then
nDefDivFont := nW div 130
else
nDefDivFont := nH div 130;
oldColor := GetTextColor(DC);
try
CtrlOpt := gAppHook.Helper.CtrlOpt;
PWC := CtrlOpt.PrtWaterCfg;
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
if (PWC.sTopText <> '') and (PWC.nTopSize > 0) then
begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := Round(70.0 * (Double(PWC.nTopSize) / 10));
end;
sText := StrsReplace(PWC.sTopText, ['{IpAddr}', '{HostName}', '{MacAddr}', '{EmpNo}', '{Dept}', '{UserName}', '{DateTime}'],
[CtrlOpt.sIpAddr, GetComName, GetMACAddr, CtrlOpt.sEmpNo, CtrlOpt.sDeptName, CtrlOpt.sUName, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
MemCanvas.Font.Size := Round(Double(nDefDivFont) * (Double(PWC.nTopSize) / 10)); // 폰트 크기 줄임 24_0619 14:23:38 kku
case PWC.nTopPos of
1 : nX := nGapW; // 왼쪽
2 : nX := ((nW + nGapW) div 2) - (MemCanvas.TextWidth(sText) div 2); // 가운데
3 : nX := nW - MemCanvas.TextWidth(sText) + nGapW; // 오른쪽
end;
MemCanvas.TextOut(nX, nGapH, sText);
end;
if (PWC.sBotText <> '') and (PWC.nBotSize > 0) then
begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := Round(70.0 * (Double(PWC.nBotSize) / 10));
end;
sText := StrsReplace(PWC.sBotText, ['{IpAddr}', '{HostName}', '{MacAddr}', '{EmpNo}', '{Dept}', '{UserName}', '{DateTime}'],
[CtrlOpt.sIpAddr, GetComName, GetMACAddr, CtrlOpt.sEmpNo, CtrlOpt.sDeptName, CtrlOpt.sUName, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
MemCanvas.Font.Size := Round(Double(nDefDivFont) * (Double(PWC.nBotSize) / 10)); // 폰트 크기 줄임 24_0619 14:23:38 kku
case PWC.nBotPos of
1 : nX := nGapW; // 왼쪽
2 : nX := ((nW + nGapW) div 2) - (MemCanvas.TextWidth(sText) div 2); // 가운데
3 : nX := nW - MemCanvas.TextWidth(sText) + nGapW; // 오른쪽
end;
MemCanvas.TextOut(nX, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,306 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_DEMO;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
type
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array[0..0] of TRGBQuad;
function ProcessWartermark_DEMO(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert, EM.DelphiZXIngQRCode, Tocsg.WinInfo, Tocsg.Network, Winapi.GDIPOBJ, Winapi.GDIPUTIL, System.Math;
procedure DrawRotatedText(Canvas: TCanvas; X, Y, Angle: Integer; const Text: string);
var
LogFont: TLogFont;
OldFont, RotatedFont: HFONT;
begin
// 기존 폰트를 기반으로 로그폰트 가져오기
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
// 회전 각도 설정 (0.1도 단위, 즉 450 = 45도)
LogFont.lfEscapement := Angle * 10;
LogFont.lfOrientation := Angle * 10;
// 안티앨리어싱 등 품질 향상 옵션
LogFont.lfQuality := ANTIALIASED_QUALITY;
// 회전 폰트 생성
RotatedFont := CreateFontIndirect(LogFont);
OldFont := SelectObject(Canvas.Handle, RotatedFont);
// 텍스트 출력
TextOut(Canvas.Handle, X, Y, PChar(Text), Length(Text));
// 자원 정리
SelectObject(Canvas.Handle, OldFont);
DeleteObject(RotatedFont);
end;
function ProcessWartermark_DEMO(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
rc: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@rc, SizeOf(rc));
GetClipBox(DC, rc);
nW := rc.Width;
nH := rc.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := '돋움'; //'Segoe UI';//'Tahoma'; // '굴림';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 60;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 160
else
MemCanvas.Font.Size := nH div 160;
oldColor := GetTextColor(DC);
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray;
SetTextColor(DC, clGray);
sText := gAppHook.Helper.sPrintWaterTxt;
// QR 코드 추가 25_1106 20:17:25 kku
var QRCode: TDelphiZXingQRCode;
Guard(QRCode, TDelphiZXingQRCode.Create);
QRCode.Data := '"' + sText + '"';
QRCode.QuietZone := 4;
var QrBmp: TBitmap;
Guard(QrBmp, TBitmap.Create);
QrBmp.SetSize(QRCode.Rows, QRCode.Columns);
var R, C, nQrSize: Integer;
for R := 0 to QRCode.Rows - 1 do
begin
for C := 0 to QRCode.Columns - 1 do
begin
if (QRCode.IsBlack[R, C]) then
begin
QrBmp.Canvas.Pixels[C, R] := clBlack;
end else
begin
QrBmp.Canvas.Pixels[C, R] := clWhite;
end;
end;
end;
ZeroMemory(@rc, SizeOf(rc));
if nW < nH then
nQrSize := nW div 20
else
nQrSize := nH div 20;
rc.Left := nW - nQrSize;
rc.Right := nW;
rc.Top := nH - nQrSize;
rc.Bottom := nH;
MemCanvas.StretchDraw(rc, QrBmp);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// 사선 텍스트
if _bmpWaterP = nil then
begin
// sText := CtrlOpt.sPrintWaterTxt;
sText := Format('%s / %s / %s', [GetComName, GetHostIP, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
sText := Format('%s / %s', [GetComName, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
sText := sText + ' ' + sText + ' ' + sText + ' ' + sText + ' ' + sText;
try
// _bmpWaterP := CreateWatermarkBitmap_Final(sText, 50, 0.35, -45, 1500);
// _bmpWaterP.SaveToFile('C:\ProgramData\HE\test1.bmp');
_bmpWaterP := TBitmap.Create;
_bmpWaterP.PixelFormat := pf32bit;
_bmpWaterP.Canvas.Font.Assign(MemCanvas.Font);
_bmpWaterP.Canvas.Font.Color := clGray;
_bmpWaterP.Canvas.Font.Size := 15;
_bmpWaterP.Canvas.Font.Style := _bmpWaterP.Canvas.Font.Style - [fsBold];
_bmpWaterP.TransparentColor := clWhite;
_bmpWaterP.Transparent := true;
var nTW: Integer := _bmpWaterP.Canvas.TextWidth(sText);
_bmpWaterP.SetSize(nTW, _bmpWaterP.Canvas.TextHeight(sText));
_bmpWaterP.Canvas.TextOut(0, 0, sText);
// _bmpWaterP.SetSize(nW, nH);
// var nGap: Integer := _bmpWaterP.Canvas.TextHeight(sText) * 18;
// DrawRotatedText(_bmpWaterP.Canvas, nGap * -1, 0, -45, sText);
// DrawRotatedText(_bmpWaterP.Canvas, 0, 0, -45, sText);
// DrawRotatedText(_bmpWaterP.Canvas, nGap, 0, -45, sText);
except
// ..
end;
end;
if _bmpWaterP <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.13))
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.15));
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
var nGap: Integer := _bmpWaterP.Canvas.TextHeight(sText) * 22;
DrawBitmapWaterEx2(MemCanvas.Handle, nGap * -1, 0, _bmpWaterP, @cTrMatrix, 0, 0, 45);
DrawBitmapWaterEx2(MemCanvas.Handle, 0, 0, _bmpWaterP, @cTrMatrix, 0, 0, 45);
DrawBitmapWaterEx2(MemCanvas.Handle, nGap, 0, _bmpWaterP, @cTrMatrix, 0, 0, 45);
// DrawBitmapWaterEx2(MemCanvas.Handle, 0, 0, _bmpWaterP, @cTrMatrix);
end;
end;
// CI 이미지 출력
{
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
var bmp: TBitmap;
Guard(bmp, TBitmap.Create);
bmp.LoadFromFile(sImgPath);
_bmpWater.SetSize(bmp.Width * 4, bmp.Height * 4);
_bmpWater.Canvas.Draw((_bmpWater.Width div 2) - (bmp.Width div 2),
(_bmpWater.Height div 2) - (bmp.Height div 2), bmp);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 150);
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.04))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
}
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,429 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_Def;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Tocsg.Trace, EM.DelphiZXingQRCode, Winapi.GDIPAPI, Tocsg.Convert;
function ProcessWartermark(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
var rc: TRect;
ZeroMemory(@rc, SizeOf(rc));
GetClipBox(DC, rc);
nW := rc.Width;
nH := rc.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
// nX := GetDeviceCaps(DC, ASPECTX);
// nY := GetDeviceCaps(DC, ASPECTY);
// bStartPage := CompareText(gAppHook.ModuleName, 'notepad.exe') = 0;
Guard(MemCanvas, TCanvas.Create);
// if bStartPage then
// begin
// MemCanvas.Handle := CreateCompatibleDC(DC);
// end else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
// hbmp := CreateCompatibleBitmap(DC, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// gAppHook.Log(Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// LogToReg('Step0', Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
// pen := CreatePen(PS_SOLID, 1, RGB(0, 255, 0));
// hOldBmp := SelectObject(MemCanvas.Handle, pen);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
// MemCanvas.Font.Orientation := 250;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
nGapW := 19;
nGapH := 17;
end;
nDefDivFont := 180;
end else
begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := 70;
end;
nDefDivFont := 190;
end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 130
else
MemCanvas.Font.Size := nH div 130;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clSilver; // 메모장등
SetTextColor(DC, clSilver); // 엑셀등
try
sText := gAppHook.Helper.sPrintWaterTxt;
SetBkMode(MemCanvas.Handle, TRANSPARENT);
case gAppHook.Helper.CtrlOpt.dwCustomerType of
CUSTOMER_UNITUS,
CUSTOMER_MOTRAS,
CUSTOMER_INZENT : MemCanvas.Font.Size := MemCanvas.Font.Size - 2; // 폰트 크기 줄임 24_0619 14:23:38 kku
CUSTOMER_SOLIDEO :
begin
// MemCanvas.Font.Color := $969696;
// SetTextColor(DC, $969696);
// MemCanvas.Font.Size := MemCanvas.Font.Size - 17;
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
MemCanvas.Font.Size := MemCanvas.Font.Size - 9;
Dec(nGapH, 7);
end;
end;
if gAppHook.Helper.CtrlOpt.dwCustomerType = CUSTOMER_DEMO then
begin
nGapH := 0;
// QR 코드 추가 25_1106 20:17:25 kku
var QRCode: TDelphiZXingQRCode;
Guard(QRCode, TDelphiZXingQRCode.Create);
QRCode.Data := sText;
QRCode.QuietZone := 4;
var QrBmp: TBitmap;
Guard(QrBmp, TBitmap.Create);
QrBmp.SetSize(QRCode.Rows, QRCode.Columns);
var R, C, nQrSize: Integer;
for R := 0 to QRCode.Rows - 1 do
begin
for C := 0 to QRCode.Columns - 1 do
begin
if (QRCode.IsBlack[R, C]) then
begin
QrBmp.Canvas.Pixels[C, R] := clBlack;
end else
begin
QrBmp.Canvas.Pixels[C, R] := clWhite;
end;
end;
end;
var rc: TRect;
if nW < nH then
nQrSize := nW div 20
else
nQrSize := nH div 20;
rc.Left := nGapW + nW - nQrSize;
rc.Right := nGapW + nW;
rc.Top := nGapH + nH - nQrSize;
rc.Bottom := nGapH + nH;
MemCanvas.StretchDraw(rc, QrBmp);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.06));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
end else begin
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
case gAppHook.Helper.CtrlOpt.dwCustomerType of
CUSTOMER_DEMO,
CUSTOMER_INZENT,
CUSTOMER_SOLIDEO,
CUSTOMER_CJONS : ;
else begin
sText := gAppHook.Helper.sCurDocName_;
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
end;
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
function ProcessWartermark_Old(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, nWW, nHH, i,
nGapH: Integer;
sOut: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
bmpText: TBitmap;
begin
Result := true;
// 엑셀 (excel.exe)의 경우 이렇게 안하면 다음 페이지로 밀리는 현상 있음.
// 아마도 DC를 별도 추가 처리 하는 듯 함 23_1024 11:00:13 kku
if _PrtDC <> DC then
exit;
gAppHook.Helper.bIsWaterMaking_ := true;
try
bStartPage := false;
try
nW := GetDeviceCaps(DC, HORZRES);
nH := GetDeviceCaps(DC, VERTRES);
Guard(MemCanvas, TCanvas.Create);
if bStartPage then
MemCanvas.Handle := CreateCompatibleDC(DC)
else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(DC, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
gAppHook.Log(Format('ProcessWartermark() - DocSize W=%d, H=%d, dc=%d', [nW, nH, DC]));
sOut := gAppHook.Helper.sPrintWaterTxt;
if _nFontSize = 0 then
begin
_nFontSize := MemCanvas.Font.Size;
while True do
begin
if _nFontSize > 200 then
break;
if MemCanvas.TextHeight(sOut) > 60 then
begin
Dec(_nFontSize);
break;
end;
Inc(_nFontSize);
MemCanvas.Font.Size := _nFontSize;
end;
end;
if _bmpWater = nil then
begin
// for i := 0 to 3 do
sOut := sOut + WORD_GAP + sOut;
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit;
// _bmpWater.PixelFormat := pf32bit;// pf4bit;
nWW := nW div 4;
nHH := nH div 4;
_bmpWater.SetSize(nWW, nHH);
_bmpWater.Canvas.Font.Assign(MemCanvas.Font);
// bmpText.Canvas.Font.Color := clSilver;
_bmpWater.Canvas.Font.Color := clGray; //$F1F1F1; // ; // ;
_bmpWater.Canvas.Font.Size := _nFontSize;
_bmpWater.Canvas.Font.Style := _bmpWater.Canvas.Font.Style + [fsBold];
_bmpWater.Canvas.FillRect(Rect(0, 0, nWW, nHH));
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
Guard(bmpText, TBitmap.Create);
bmpText.PixelFormat := pf4bit;
// bmpText.PixelFormat := pf32bit;// pf4bit;
bmpText.Canvas.Font.Assign(MemCanvas.Font);
// bmpText.Canvas.Font.Color := clSilver;
bmpText.Canvas.Font.Color := clSilver;//$F1F1F1;
bmpText.Canvas.Font.Size := _nFontSize;
bmpText.Canvas.Font.Style := bmpText.Canvas.Font.Style + [fsBold];
// bmpText.Canvas.Font.Orientation := 250;
bmpText.SetSize(_bmpWater.Canvas.TextWidth(sOut), _bmpWater.Canvas.TextHeight(sOut));
bmpText.Canvas.Brush.Color := clWhite;
bmpText.Canvas.Brush.Style := bsSolid;
// SetBkMode(bmpText.Canvas.Handle, TRANSPARENT);
// var textColor: COLORREF := RGB(255, 0, 0);
// var textAlpha: Integer := 128;
// textColor := textColor and ($00FFFFFF or textAlpha shl 24);
// SetTextColor(bmpText.Canvas.Handle, textColor);
bmpText.Canvas.TextOut(0, 0, sOut);
var ii: Integer;
var jj: Integer;
for ii := 0 to bmpText.Width - 1 do
for jj := 0 to bmpText.Height - 1 do
if bmpText.Canvas.Pixels[ii, jj] <> clWhite then
if ((ii + jj) mod 2) = 0 then
bmpText.Canvas.Pixels[ii, jj] := clWhite
else
bmpText.Canvas.Pixels[ii, jj] := clGray;
// bmpText.Canvas.Pixels[ii, jj] := bmpText.Canvas.Pixels[ii, jj] and $00FFFFFF or textAlpha shl 24;
RotateBitmap_PlgBlt(bmpText, -0.45, true, clWhite);
// bmpText.Canvas.FillRect(Rect(0, 0, nWW, nHH));
// bmpText.TransparentColor := clWhite;
// bmpText.Transparent := true;
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapH := bmpText.Height; // nHH div (nRepeat - 1);
i := (nGapH div 2) * -1;
while i < nHH + nGapH do
begin
_bmpWater.Canvas.Draw(0, i, bmpText);
Inc(i, nGapH);
end;
// bmpText.Canvas.TextOut(0, bmpText.Height - (bmpText.Height div 3), sOut);
end;
if _bmpWater <> nil then
MemCanvas.StretchDraw(Rect(0, 0, nW, nH), _bmpWater);
DeleteObject(hbmp);
if bStartPage then
DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
end;
end;
end.

View File

@ -0,0 +1,522 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_GEC;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_GEC(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg;
function ProcessWartermark_GEC(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nWW, nHH, nXX, nYY,
nGapW, nGapH: Integer;
sText, sOut, sImgPath: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
hOldFont: HFONT;
nDPI, nFontH, nFontHmax: Integer;
// 만들어 놓은 BMP를 재사용하면 배경 투명처리가 안되서 이렇게 사용 23_1221 08:15:33 kku
function CreateTextBmp(sOutText: String): TBitmap;
begin
Result := TBitmap.Create;
Result.PixelFormat := pf4bit;
Result.Canvas.Font.Assign(MemCanvas.Font);
// Result.Canvas.Font.Color := clSilver;
// if nFontSize <> -1 then
// Result.Canvas.Font.Size := nFontSize;
Result.SetSize(Result.Canvas.TextWidth(sOutText), Result.Canvas.TextHeight(sOutText));
// Result.Canvas.Brush.Color := clWhite;
// Result.Canvas.Brush.Style := bsSolid;
// SetBkMode(Result.Canvas.Handle, TRANSPARENT);
SetBkColor(Result.Canvas.Handle, RGB(255, 255, 255));
Result.Canvas.TextOut(0, 0, sOutText);
Result.TransparentColor := clWhite;
Result.Transparent := true;
end;
begin
Result := true;
// if _nRecentPage < gAppHook.Helper.nPtrCnt_ then
// _nRecentPage := gAppHook.Helper.nPtrCnt_
// else exit;
// if _nRecentPage > 0 then
// exit;
// _nRecentPage := 1;
// 엑셀 (excel.exe)의 경우 이렇게 안하면 다음 페이지로 밀리는 현상 있음.
// 아마도 DC를 별도 추가 처리 하는 듯 함 23_1024 11:00:13 kku
if _PrtDC <> DC then
exit;
if _bIgrPrtWater then
exit;
// if gAppHook.Helper.IsExcel then
// begin
// if bStartPage then
// LogToReg(Format('WATER_Excel_ST_%d', [_nTest]), Format('DC=%d, W=%d, H=%d', [DC, GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]))
// else
// LogToReg(Format('WATER_Excel_ED_%d', [_nTest]), Format('DC=%d, W=%d, H=%d', [DC, GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
// Inc(_nTest);
// end;
bStartPage := false;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
// nW := GetDeviceCaps(DC, PHYSICALWIDTH); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
// nH := GetDeviceCaps(DC, PHYSICALHEIGHT); // 가로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 가로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
nX := GetDeviceCaps(DC, ASPECTX);
nY := GetDeviceCaps(DC, ASPECTY);
// 인도현지 프린터 종류
// 캐논 IRC3326, 쿄세라(kyocera) M8124
nDPI := GetDeviceCaps(DC, LOGPIXELSX);
// LogToReg('PrinterDPI', IntToStr(nDPI));
if nDPI < 600 then
begin
// 인도 현지 캐논 프린트 최대 DPI가 300이다 24_0621 10:22:10 kku
nFontH := 70;
nFontHmax := 80;
end else begin
nFontH := 180;
nFontHmax := 200;
end;
// 작업 후 폰트 롤백을 위한 백업 23_1018 11:21:29 kku
hOldFont := GetCurrentObject(DC, OBJ_FONT);
Guard(MemCanvas, TCanvas.Create);
if bStartPage then // 필요없음
MemCanvas.Handle := CreateCompatibleDC(DC)
else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
gAppHook.Log(Format('ProcessWartermark_GEC() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
if bStartPage then
PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
oldColor := GetTextColor(MemCanvas.Handle);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(MemCanvas.Handle, clGray); // 엑셀등
// MemCanvas.Font.Name := 'Tahoma';
// MemCanvas.Font.Name := '돋음';
if gAppHook.Helper.bEndDocProc_ then
begin
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'MSIP.Viewer.exe') = 0) then
nGapH := 85;
end;
MemCanvas.Font.Size := 60;
// sOut := gAppHook.Helper.CtrlOpt.sPrintWaterTxt;
sOut := '';
if gAppHook.Helper.CtrlOpt.sDeptName <> '' then
SumString(sOut, gAppHook.Helper.CtrlOpt.sDeptName, '/');
if gAppHook.Helper.CtrlOpt.sEmpNo <> '' then
SumString(sOut, gAppHook.Helper.CtrlOpt.sEmpNo, '/');
if gAppHook.Helper.sPrintWaterTxt <> '' then
SumString(sOut, gAppHook.Helper.sPrintWaterTxt, '/');
SumString(sOut, FormatDateTime('yyyy-mm-dd', Now), '/');
if _sbmpWaterIf <> sOut then
begin
// 이미지 캐시 초기화 추가 24_1213 14:05:40 kku
_sbmpWaterIf := sOut;
if _bmpWater <> nil then
FreeAndNil(_bmpWater);
if _bmpWaterP <> nil then
FreeAndNil(_bmpWater);
end;
if _nFontSize = 0 then
begin
_nFontSize := MemCanvas.Font.Size;
while True do
begin
if _nFontSize > nFontHmax then
break;
// if MemCanvas.TextWidth(sOut) > 3000 then // 부서명이 들어간 후 2000에서 변경
if MemCanvas.TextHeight(sOut) > nFontH then // 부서명이 들어간 후 2000에서 변경
begin
Dec(_nFontSize);
break;
end;
Inc(_nFontSize);
MemCanvas.Font.Size := _nFontSize;
end;
end;
if nDPI < 600 then
MemCanvas.Font.Size := _nFontSize - Round(_nFontSize / 2.5)
else
MemCanvas.Font.Size := _nFontSize - (_nFontSize div 3);
// sOut := IntToStr(MemCanvas.Font.Size) + ' - ' + sOut;
try
if gAppHook.Helper.bSmallFont_ then
begin
// 브라우저등의 경우... 폰트 크기를 가늠할수가 없다.
// 그래서 아래처럼 이미지로 처리 23_1017 13:10:40 kku
// var bmpText: TBitmap;
// Guard(bmpText, TBitmap.Create);
// bmpText.PixelFormat := pf4bit;
// bmpText.Canvas.Font.Assign(MemCanvas.Font);
// bmpText.Canvas.Font.Size := 12;
// bmpText.Canvas.Brush.Color := clWhite;
//// bmpText.Canvas.Brush.Style := bsClear;
//// bmpText.font
// sText := '작은 습관으로 시작되는 보안';
// bmpText.SetSize(bmpText.Canvas.TextWidth(sText), bmpText.Canvas.TextHeight(sText));
// bmpText.Canvas.TextOut(0, 0, sText);
// MemCanvas.Draw(nW - bmpText.Width + nGapW + nGapW2, nH - bmpText.Height + nGapH + nGapH2, bmpText);
// 음..브라우저에서 상하단 문구 제거 23_1017 13:26:47 kku
end else begin
// var sDocInfo: String := 'c:\ProgramData\HE\Task\$TEST.txt';
// begin
// if FileExists(sDocInfo) then
// begin
// var StrList: TStringList;
// Guard(StrList, TStringList.Create);
// StrList.LoadFromFile(sDocInfo, TEncoding.UTF8);
// DeleteFile(sDocInfo);
// if StrList.Text <> '' then
// begin
// sText := StrList.Text;
// MemCanvas.TextOut(nGapW - MemCanvas.TextWidth(sText), nGapH, Format('%s', [sText]));
// end;
// end;
// end;
var bmpText: TBitmap;
var rcText: TRect;
// 우측 상단
if _sLabelName <> '' then
begin
sText := _sLabelName;
if nDPI > 300 then
sText := sText + ' '; // 쿄세라 프린터에서 오른쪽 짤리는 현상이 있어서 공백 하나 넣어줌 24_0621 11:11:28 kku
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := 0;
rcText.Bottom := bmpText.Height + 1;
// MemCanvas.Draw(nW - bmpText.Width, 0, bmpText);
MemCanvas.StretchDraw(rcText, bmpText); // 이렇게 해야 프린터에서 인식함.. 24_0108 14:25:59 kku
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(_sLabelName) + nGapW, nGapH, _sLabelName);
end;
// 우측 하단
begin
sText := 'Security Starts with Small Habits';
if nDPI > 300 then
sText := sText + ' '; // 쿄세라 프린터에서 오른쪽 짤리는 현상이 있어서 공백 하나 넣어줌 24_0621 11:11:28 kku
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width + nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - bmpText.Height;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// 왜인지는 모르겠지만.. 아래 텍스트와는 다르게 세로 갭을 넣을 필요가 없다... (winword.exe) 23_1211 16:10:21 kku
// MemCanvas.Draw(nW - bmpText.Width + nGapW, nH - bmpText.Height, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
// sText := Format('px=%d, 작은 습관으로 시작되는 보안', [MemCanvas.Font.PixelsPerInch]);
// sText := '작은 습관으로 시작되는 보안';
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
// nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
//
if nDPI < 600 then
MemCanvas.Font.Size := _nFontSize div 5
else
MemCanvas.Font.Size := _nFontSize div 4;
// 좌측 하단
// begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// Guard(bmpText, CreateTextBmp(sText));
//
// ZeroMemory(@rcText, SizeOf(rcText));
// rcText.Left := nGapW;
// rcText.Right := rcText.Left + bmpText.Width + 1;
// rcText.Top := nH - (bmpText.Height * 2);
// rcText.Bottom := rcText.Top + bmpText.Height + 1;
//
//// MemCanvas.Draw(nGapW, nH - (bmpText.Height * 2), bmpText);
// MemCanvas.StretchDraw(rcText, bmpText);
// end;
begin
sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
if nDPI > 300 then
sText := ' ' + sText; // 쿄세라 프린터에서 왼쪽 짤리는 현상이 있어서 공백 넣어줌 24_0621 11:11:28 kku
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - bmpText.Height - 5;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(nGapW, nH - bmpText.Height - 5, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
sText := '';
if gAppHook.Helper.CtrlOpt.sDeptName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sDeptName, '/');
if gAppHook.Helper.CtrlOpt.sUName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sUName, '/');
SumString(sText, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), '/');
// 좌측 상단
// begin
// Guard(bmpText, CreateTextBmp(sText));
//
// ZeroMemory(@rcText, SizeOf(rcText));
// rcText.Left := 0;
// rcText.Right := rcText.Left + bmpText.Width + 1;
// rcText.Top := 0;
// rcText.Bottom := rcText.Top + bmpText.Height + 1;
//
//// MemCanvas.Draw(0, 0, bmpText);
// MemCanvas.StretchDraw(rcText, bmpText);
// end;
// if nGapH = 85 then
// begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH - 65, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH - 65, sText);
// end else begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH, sText);
// end;
end;
// 워터마크 이미지 처리 23_1011 10:41:31 kku
sImgPath := ExtractFilePath(gAppHook.Helper.DllPath) + 'HWMJ.dat';
if FileExists(sImgPath) then
begin
if _bmpWaterP = nil then
begin
var jpg: TJPEGImage;
// Guard(jpg, TJPEGImage.Create);
jpg := TJPEGImage.Create;
jpg.LoadFromFile(sImgPath);
var bmpImg: TBitmap;
// Guard(bmpImg, TBitmap.Create);
bmpImg := TBitmap.Create;
bmpImg.Assign(jpg);
jpg.Free; // Free
// bmpImg.Canvas.Font.Name := 'Tahoma';
// bmpImg.Canvas.Font.Name := '돋음';
bmpImg.Canvas.Font.Assign(MemCanvas.Font);
bmpImg.Canvas.Font.Color := clSilver;
// bmpImg.Canvas.Font.Size := 40;
bmpImg.Canvas.Font.Size := _nFontSize - (_nFontSize div 2);
bmpImg.Canvas.Font.Style := bmpImg.Canvas.Font.Style + [fsBold];
//---
// sOut := '정보보호부문/2323308/10.177.15.123/2023-12-31';
// HEC 새로운 요구사항 반영 23_1121 10:22:09 kku
// bmpImg.Canvas.Font.Size := bmpImg.Canvas.Font.Size + 14;
// ScalePercentBmp(bmpImg, 120);
//---
if nDPI < 600 then
bmpImg.Canvas.Font.Size := bmpImg.Canvas.Font.Size + 20;
nWW := bmpImg.Canvas.TextWidth(sOut);
if bmpImg.Width > nWW then
nWW := bmpImg.Width;
nHH := bmpImg.Height + bmpImg.Canvas.TextHeight(sOut);
_bmpWaterP := TBitmap.Create;
_bmpWaterP.Canvas.Font.Assign(bmpImg.Canvas.Font);
_bmpWaterP.PixelFormat := pf4bit; // pf32bit;
_bmpWaterP.SetSize(nWW, nHH);
_bmpWaterP.Canvas.Brush.Color := clWhite;
_bmpWaterP.Canvas.Brush.Style := bsSolid;
_bmpWaterP.Canvas.FillRect(Rect(0, 0, _bmpWaterP.Width, _bmpWaterP.Height));
// _bmpWaterP.Canvas.Brush.Style := bsClear; // x
_bmpWaterP.Canvas.Draw((nWW div 2) - (bmpImg.Width div 2), 0, bmpImg);
_bmpWaterP.Canvas.TextOut(0, bmpImg.Height, sOut);
// _bmpWaterP.Canvas.TextOut(0, (_bmpWaterP.Height div 2) - (_bmpWaterP.Canvas.TextHeight(sOut) div 2), sOut);
bmpImg.Free; // Free
// RotateBitmap_STF(_bmpWaterP, -0.7, true, clWhite, 200);
RotateBitmap_PlgBlt(_bmpWaterP, -0.7, true, clWhite);
var ii: Integer;
var jj: Integer;
if gAppHook.Helper.IsExcel then
begin
// 도트 투명도 설정
for ii := 0 to _bmpWaterP.Width - 1 do
for jj := 0 to _bmpWaterP.Height - 1 do
if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
if ((ii + jj) mod 4) = 0 then
_bmpWaterP.Canvas.Pixels[ii, jj] := clWhite
else
_bmpWaterP.Canvas.Pixels[ii, jj] := clSilver;
end else
begin
for ii := 0 to _bmpWaterP.Width - 1 do
for jj := 0 to _bmpWaterP.Height - 1 do
if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
_bmpWaterP.Canvas.Pixels[ii, jj] := clGray;
end;
// if nDPI < 600 then
// ScalePercentBmp(_bmpWaterP, 65)
// else
ScalePercentBmp(_bmpWaterP, 60);
_bmpWaterP.TransparentColor := clWhite;
_bmpWaterP.Transparent := true;
end;
if (_bmpWater = nil) and (_bmpWaterP <> nil) then
begin
// HEC 보안프린터에서 컬러 출력시 아래 부분이 검은색으로 찍히는 문제가 있다...
// 이렇게 크기를 반으로 줄이고 덮어쓸때 늘리면 해결됨... 23_1103 13:42:54 kku
var nIW: Integer := nW - (nW div 2);
var nIH: Integer := nH - (nH div 2);
if nDPI < 600 then
begin
nIW := nIW * 2;
nIH := nIH * 2;
end;
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit;
// _bmpWater.SetSize(nW-1, nH-1); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.SetSize(nIW, nIH); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.Canvas.Brush.Color := clWhite;// clRed;
_bmpWater.Canvas.Brush.Style := bsSolid;
_bmpWater.Canvas.FillRect(Rect(0, 0, _bmpWater.Width, _bmpWater.Height));
// _bmpWater.Canvas.Brush.Style := bsClear;
// bmpWater.SaveToFile('C:\Users\kkuzil\Desktop\출력테스트\1.bmp');
nX := (nIW div 2) - (_bmpWaterP.Width div 2);
nY := (nIH div 2) - (nIH div 3);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
nY := (nIH div 2) + (nIH div 10);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
end;
if bStartPage then
begin
// 왜인지는 모르겠지만... 워터마크 크기에 +1을 안해주면
// FinePrint, HEC 보안프린터에서 이미지 출력이 되지 않는다...23_1017 10:56:48 kku
nWW := _bmpWaterP.Width + 1;
nHH := _bmpWaterP.Height + 1;
// nWW := Round((nScalePercent / 100) * bmpWater.Width);
// nHH := Round((nScalePercent / 100) * bmpWater.Height);
nX := (nW div 2) - (nWW div 2);
nY := (nH div 2) - (nH div 3);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
nY := (nH div 2) + (nH div 10);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
end else
if _bmpWater <> nil then
begin
if gAppHook.Helper.IsExcel then
MemCanvas.StretchDraw(Rect(0, 0, nW, nH), _bmpWater)
else
DrawBitmapWater(MemCanvas.Handle, 0, 0, _bmpWater);
end;
end;
if bStartPage then
BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
finally
SetTextColor(MemCanvas.Handle, oldColor);
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
if bStartPage then // 필요없음
DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
SelectObject(DC, hOldFont);
end;
gAppHook.Log(Format('ProcessWartermark_GEC() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,977 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_HEC;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_HEC(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg;
function ProcessWartermark_HEC(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nWW, nHH, nXX, nYY,
nGapW, nGapH: Integer;
sText, sOut, sImgPath: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
hOldFont: HFONT;
// 만들어 놓은 BMP를 재사용하면 배경 투명처리가 안되서 이렇게 사용 23_1221 08:15:33 kku
function CreateTextBmp(sOutText: String): TBitmap;
begin
Result := TBitmap.Create;
Result.PixelFormat := pf4bit;
Result.Canvas.Font.Assign(MemCanvas.Font);
// Result.Canvas.Font.Color := clSilver;
// if nFontSize <> -1 then
// Result.Canvas.Font.Size := nFontSize;
Result.SetSize(Result.Canvas.TextWidth(sOutText), Result.Canvas.TextHeight(sOutText));
Result.Canvas.Brush.Color := clWhite;
Result.Canvas.Brush.Style := bsSolid;
Result.TransparentColor := clWhite;
Result.Transparent := true;
Result.Canvas.TextOut(0, 0, sOutText);
end;
begin
Result := true;
// 엑셀 (excel.exe)의 경우 이렇게 안하면 다음 페이지로 밀리는 현상 있음.
// 아마도 DC를 별도 추가 처리 하는 듯 함 23_1024 11:00:13 kku
if _PrtDC <> DC then
exit;
if _bIgrPrtWater then
exit;
// if gAppHook.Helper.IsExcel then
// begin
// if bStartPage then
// LogToReg(Format('WATER_Excel_ST_%d', [_nTest]), Format('DC=%d, W=%d, H=%d', [DC, GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]))
// else
// LogToReg(Format('WATER_Excel_ED_%d', [_nTest]), Format('DC=%d, W=%d, H=%d', [DC, GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
// Inc(_nTest);
// end;
bStartPage := false;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 가로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
nX := GetDeviceCaps(DC, ASPECTX);
nY := GetDeviceCaps(DC, ASPECTY);
// 작업 후 폰트 롤백을 위한 백업 23_1018 11:21:29 kku
hOldFont := GetCurrentObject(DC, OBJ_FONT);
Guard(MemCanvas, TCanvas.Create);
if bStartPage then // 필요없음
MemCanvas.Handle := CreateCompatibleDC(DC)
else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
gAppHook.Log(Format('ProcessWartermark_HEC() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
if bStartPage then
PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
oldColor := GetTextColor(MemCanvas.Handle);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(MemCanvas.Handle, clGray); // 엑셀등
// MemCanvas.Font.Name := 'Tahoma';
// MemCanvas.Font.Name := '돋음';
if gAppHook.Helper.bSmallFont_ then
begin
// 크롬, 엣지에 맞춤 23_0327 18:56:18 kku
if nW < nH then
begin
// 세로
if nW <> 4961 then
begin
// 크롬, 엣지 여백 보정
nGapW := 15;
nGapH := 15;
end;
MemCanvas.Font.Size := 9;
nW := (nW div 7) + 50;
nH := (nH div 7) + 70;
end else begin
// 가로
if nH <> 4961 then
begin
// 크롬, 엣지 여백 보정
nGapW := 20;
nGapH := 20;
end;
MemCanvas.Font.Size := 12;
nW := ((nW div 5) + 105);
nH := ((nH div 5) + 85);
end;
// if CompareText(gAppHook.ModuleName, 'chrome.exe') = 0 then
// nGapW2 := -10;
// nGapH2 := -5;
end else begin
if gAppHook.Helper.bEndDocProc_ then
begin
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'MSIP.Viewer.exe') = 0) then
nGapH := 85;
end;
MemCanvas.Font.Size := 60;
end;
// sOut := gAppHook.Helper.CtrlOpt.sPrintWaterTxt;
sOut := '';
if gAppHook.Helper.CtrlOpt.sDeptName <> '' then
SumString(sOut, gAppHook.Helper.CtrlOpt.sDeptName, '/');
if gAppHook.Helper.CtrlOpt.sEmpNo <> '' then
SumString(sOut, gAppHook.Helper.CtrlOpt.sEmpNo, '/');
if gAppHook.Helper.sPrintWaterTxt <> '' then
SumString(sOut, gAppHook.Helper.sPrintWaterTxt, '/');
SumString(sOut, FormatDateTime('yyyy-mm-dd', Now), '/');
if _sbmpWaterIf <> sOut then
begin
// 이미지 캐시 초기화 추가 24_1213 14:05:40 kku
_sbmpWaterIf := sOut;
if _bmpWater <> nil then
FreeAndNil(_bmpWater);
if _bmpWaterP <> nil then
FreeAndNil(_bmpWater);
end;
if _nFontSize = 0 then
begin
_nFontSize := MemCanvas.Font.Size;
while True do
begin
if _nFontSize > 200 then
break;
// if MemCanvas.TextWidth(sOut) > 3000 then // 부서명이 들어간 후 2000에서 변경
if MemCanvas.TextHeight(sOut) > 180 then // 부서명이 들어간 후 2000에서 변경
begin
Dec(_nFontSize);
break;
end;
Inc(_nFontSize);
MemCanvas.Font.Size := _nFontSize;
end;
end;
MemCanvas.Font.Size := _nFontSize - (_nFontSize div 3);
// sOut := IntToStr(MemCanvas.Font.Size) + ' - ' + sOut;
try
if gAppHook.Helper.bSmallFont_ then
begin
// 브라우저등의 경우... 폰트 크기를 가늠할수가 없다.
// 그래서 아래처럼 이미지로 처리 23_1017 13:10:40 kku
// var bmpText: TBitmap;
// Guard(bmpText, TBitmap.Create);
// bmpText.PixelFormat := pf4bit;
// bmpText.Canvas.Font.Assign(MemCanvas.Font);
// bmpText.Canvas.Font.Size := 12;
// bmpText.Canvas.Brush.Color := clWhite;
//// bmpText.Canvas.Brush.Style := bsClear;
//// bmpText.font
// sText := '작은 습관으로 시작되는 보안';
// bmpText.SetSize(bmpText.Canvas.TextWidth(sText), bmpText.Canvas.TextHeight(sText));
// bmpText.Canvas.TextOut(0, 0, sText);
// MemCanvas.Draw(nW - bmpText.Width + nGapW + nGapW2, nH - bmpText.Height + nGapH + nGapH2, bmpText);
// 음..브라우저에서 상하단 문구 제거 23_1017 13:26:47 kku
end else begin
// var sDocInfo: String := 'c:\ProgramData\HE\Task\$TEST.txt';
// begin
// if FileExists(sDocInfo) then
// begin
// var StrList: TStringList;
// Guard(StrList, TStringList.Create);
// StrList.LoadFromFile(sDocInfo, TEncoding.UTF8);
// DeleteFile(sDocInfo);
// if StrList.Text <> '' then
// begin
// sText := StrList.Text;
// MemCanvas.TextOut(nGapW - MemCanvas.TextWidth(sText), nGapH, Format('%s', [sText]));
// end;
// end;
// end;
var bmpText: TBitmap;
var rcText: TRect;
// 우측 상단
if _sLabelName <> '' then
begin
Guard(bmpText, CreateTextBmp(_sLabelName));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := 0;
rcText.Bottom := bmpText.Height + 1;
// MemCanvas.Draw(nW - bmpText.Width, 0, bmpText);
MemCanvas.StretchDraw(rcText, bmpText); // 이렇게 해야 프린터에서 인식함.. 24_0108 14:25:59 kku
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(_sLabelName) + nGapW, nGapH, _sLabelName);
end;
// 우측 하단
begin
// Guard(bmpText, CreateTextBmp('작은 습관으로 시작되는 보안'));
Guard(bmpText, CreateTextBmp('모두의 보안, 실천은 나로부터')); // 변경 25_0616 15:05:12 kku
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width + nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - bmpText.Height;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// 왜인지는 모르겠지만.. 아래 텍스트와는 다르게 세로 갭을 넣을 필요가 없다... (winword.exe) 23_1211 16:10:21 kku
// MemCanvas.Draw(nW - bmpText.Width + nGapW, nH - bmpText.Height, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
// sText := Format('px=%d, 모두의 보안, 실천은 나로부터', [MemCanvas.Font.PixelsPerInch]);
// sText := '모두의 보안, 실천은 나로부터';
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
// nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
//
MemCanvas.Font.Size := _nFontSize div 4;
// 좌측 하단
begin
sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - (bmpText.Height * 2);
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(nGapW, nH - (bmpText.Height * 2), bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
// begin
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// Guard(bmpText, CreateTextBmp(sText));
//
// ZeroMemory(@rcText, SizeOf(rcText));
// rcText.Left := nGapW;
// rcText.Right := rcText.Left + bmpText.Width + 1;
// rcText.Top := nH - bmpText.Height - 5;
// rcText.Bottom := rcText.Top + bmpText.Height + 1;
//
//// MemCanvas.Draw(nGapW, nH - bmpText.Height - 5, bmpText);
// MemCanvas.StretchDraw(rcText, bmpText);
// end;
sText := '';
if gAppHook.Helper.CtrlOpt.sDeptName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sDeptName, '/');
if gAppHook.Helper.CtrlOpt.sUName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sUName, '/');
SumString(sText, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), '/');
// 좌측 상단
begin
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := 0;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := 0;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(0, 0, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
// if nGapH = 85 then
// begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH - 65, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH - 65, sText);
// end else begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH, sText);
// end;
end;
// 워터마크 이미지 처리 23_1011 10:41:31 kku
sImgPath := ExtractFilePath(gAppHook.Helper.DllPath) + 'HWMJ.dat';
if FileExists(sImgPath) then
begin
if _bmpWaterP = nil then
begin
var jpg: TJPEGImage;
// Guard(jpg, TJPEGImage.Create);
jpg := TJPEGImage.Create;
jpg.LoadFromFile(sImgPath);
var bmpImg: TBitmap;
// Guard(bmpImg, TBitmap.Create);
bmpImg := TBitmap.Create;
bmpImg.Assign(jpg);
jpg.Free; // Free
// bmpImg.Canvas.Font.Name := 'Tahoma';
// bmpImg.Canvas.Font.Name := '돋음';
bmpImg.Canvas.Font.Assign(MemCanvas.Font);
bmpImg.Canvas.Font.Color := clSilver;
// bmpImg.Canvas.Font.Size := 40;
bmpImg.Canvas.Font.Size := _nFontSize - (_nFontSize div 2);
bmpImg.Canvas.Font.Style := bmpImg.Canvas.Font.Style + [fsBold];
//---
// sOut := '정보보호부문/2323308/10.177.15.123/2023-12-31';
// HEC 새로운 요구사항 반영 23_1121 10:22:09 kku
// bmpImg.Canvas.Font.Size := bmpImg.Canvas.Font.Size + 14;
// ScalePercentBmp(bmpImg, 120);
//---
nWW := bmpImg.Canvas.TextWidth(sOut);
if bmpImg.Width > nWW then
nWW := bmpImg.Width;
nHH := bmpImg.Height + bmpImg.Canvas.TextHeight(sOut);
_bmpWaterP := TBitmap.Create;
_bmpWaterP.Canvas.Font.Assign(bmpImg.Canvas.Font);
_bmpWaterP.PixelFormat := pf4bit;
_bmpWaterP.SetSize(nWW, nHH);
_bmpWaterP.Canvas.Brush.Color := clWhite;
_bmpWaterP.Canvas.Brush.Style := bsSolid;
_bmpWaterP.Canvas.FillRect(Rect(0, 0, _bmpWaterP.Width, _bmpWaterP.Height));
// _bmpWaterP.Canvas.Brush.Style := bsClear; // x
_bmpWaterP.Canvas.Draw((nWW div 2) - (bmpImg.Width div 2), 0, bmpImg);
_bmpWaterP.Canvas.TextOut(0, bmpImg.Height, sOut);
// _bmpWaterP.Canvas.TextOut(0, (_bmpWaterP.Height div 2) - (_bmpWaterP.Canvas.TextHeight(sOut) div 2), sOut);
bmpImg.Free; // Free
// RotateBitmap_STF(_bmpWaterP, -0.7, true, clWhite, 200);
RotateBitmap_PlgBlt(_bmpWaterP, -0.7, true, clWhite);
var ii: Integer;
var jj: Integer;
if gAppHook.Helper.IsExcel then
begin
// 도트 투명도 설정
for ii := 0 to _bmpWaterP.Width - 1 do
for jj := 0 to _bmpWaterP.Height - 1 do
if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
if ((ii + jj) mod 4) = 0 then
_bmpWaterP.Canvas.Pixels[ii, jj] := clWhite
else
_bmpWaterP.Canvas.Pixels[ii, jj] := clSilver;
end else begin
for ii := 0 to _bmpWaterP.Width - 1 do
for jj := 0 to _bmpWaterP.Height - 1 do
if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
_bmpWaterP.Canvas.Pixels[ii, jj] := clGray;
end;
// 이렇게 안줄이고 할수 있는데... 원본으로 할 경우 보안프린터에서 이상하게 찍힘 23_1212 15:13:35 kku
// if gAppHook.Helper.bSmallFont_ then
// ScalePercentBmp(_bmpWaterP, 10)
// else
ScalePercentBmp(_bmpWaterP, 60);
_bmpWaterP.TransparentColor := clWhite;
_bmpWaterP.Transparent := true;
end;
if (_bmpWater = nil) and (_bmpWaterP <> nil) then
begin
// HEC 보안프린터에서 컬러 출력시 아래 부분이 검은색으로 찍히는 문제가 있다...
// 이렇게 크기를 반으로 줄이고 덮어쓸때 늘리면 해결됨... 23_1103 13:42:54 kku
var nIW: Integer := nW - (nW div 2);
var nIH: Integer := nH - (nH div 2);
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit;
// _bmpWater.SetSize(nW-1, nH-1); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.SetSize(nIW, nIH); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.Canvas.Brush.Color := clWhite;// clRed;
_bmpWater.Canvas.Brush.Style := bsSolid;
_bmpWater.Canvas.FillRect(Rect(0, 0, _bmpWater.Width, _bmpWater.Height));
// _bmpWater.Canvas.Brush.Style := bsClear;
// bmpWater.SaveToFile('C:\Users\kkuzil\Desktop\출력테스트\1.bmp');
nX := (nIW div 2) - (_bmpWaterP.Width div 2);
nY := (nIH div 2) - (nIH div 3);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
nY := (nIH div 2) + (nIH div 10);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
end;
if bStartPage then
begin
// 왜인지는 모르겠지만... 워터마크 크기에 +1을 안해주면
// FinePrint, HEC 보안프린터에서 이미지 출력이 되지 않는다...23_1017 10:56:48 kku
nWW := _bmpWaterP.Width + 1;
nHH := _bmpWaterP.Height + 1;
// nWW := Round((nScalePercent / 100) * bmpWater.Width);
// nHH := Round((nScalePercent / 100) * bmpWater.Height);
nX := (nW div 2) - (nWW div 2);
nY := (nH div 2) - (nH div 3);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
nY := (nH div 2) + (nH div 10);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
end else
if _bmpWater <> nil then
begin
// 이렇게 통짜로 적용해야 HEC 보안프린터- 메모장에서 색상 적용이 먹힌다
// MemCanvas.StretchDraw(Rect(0, 0, nW, nH), _bmpWater);
if gAppHook.Helper.IsExcel then
MemCanvas.StretchDraw(Rect(0, 0, nW, nH), _bmpWater)
else
DrawBitmapWater(MemCanvas.Handle, 0, 0, _bmpWater);
end;
end;
if bStartPage then
BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
finally
SetTextColor(MemCanvas.Handle, oldColor);
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
if bStartPage then // 필요없음
DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
SelectObject(DC, hOldFont);
end;
gAppHook.Log(Format('ProcessWartermark_HEC() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
function ProcessWartermark_HEC_Backup(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nWW, nHH, nXX, nYY,
nGapW, nGapH: Integer;
sText, sOut, sImgPath: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
hOldFont: HFONT;
// 만들어 놓은 BMP를 재사용하면 배경 투명처리가 안되서 이렇게 사용 23_1221 08:15:33 kku
function CreateTextBmp(sOutText: String): TBitmap;
begin
Result := TBitmap.Create;
Result.PixelFormat := pf4bit;
Result.Canvas.Font.Assign(MemCanvas.Font);
// Result.Canvas.Font.Color := clSilver;
// if nFontSize <> -1 then
// Result.Canvas.Font.Size := nFontSize;
Result.SetSize(Result.Canvas.TextWidth(sOutText), Result.Canvas.TextHeight(sOutText));
Result.Canvas.Brush.Color := clWhite;
Result.Canvas.Brush.Style := bsSolid;
Result.TransparentColor := clWhite;
Result.Transparent := true;
Result.Canvas.TextOut(0, 0, sOutText);
end;
begin
Result := true;
// 엑셀 (excel.exe)의 경우 이렇게 안하면 다음 페이지로 밀리는 현상 있음.
// 아마도 DC를 별도 추가 처리 하는 듯 함 23_1024 11:00:13 kku
if _PrtDC <> DC then
exit;
if _bIgrPrtWater then
exit;
bStartPage := false;
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 가로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
nX := GetDeviceCaps(DC, ASPECTX);
nY := GetDeviceCaps(DC, ASPECTY);
// 작업 후 폰트 롤백을 위한 백업 23_1018 11:21:29 kku
hOldFont := GetCurrentObject(DC, OBJ_FONT);
Guard(MemCanvas, TCanvas.Create);
if bStartPage then // 필요없음
MemCanvas.Handle := CreateCompatibleDC(DC)
else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
gAppHook.Log(Format('ProcessWartermark_HEC() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
if bStartPage then
PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
oldColor := GetTextColor(MemCanvas.Handle);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(MemCanvas.Handle, clGray); // 엑셀등
// MemCanvas.Font.Name := 'Tahoma';
// MemCanvas.Font.Name := '돋음';
if gAppHook.Helper.bSmallFont_ then
begin
// 크롬, 엣지에 맞춤 23_0327 18:56:18 kku
if nW < nH then
begin
// 세로
if nW <> 4961 then
begin
// 크롬, 엣지 여백 보정
nGapW := 15;
nGapH := 15;
end;
MemCanvas.Font.Size := 9;
nW := (nW div 7) + 50;
nH := (nH div 7) + 70;
end else begin
// 가로
if nH <> 4961 then
begin
// 크롬, 엣지 여백 보정
nGapW := 20;
nGapH := 20;
end;
MemCanvas.Font.Size := 12;
nW := ((nW div 5) + 105);
nH := ((nH div 5) + 85);
end;
// if CompareText(gAppHook.ModuleName, 'chrome.exe') = 0 then
// nGapW2 := -10;
// nGapH2 := -5;
end else begin
if gAppHook.Helper.bEndDocProc_ then
begin
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'MSIP.Viewer.exe') = 0) then
nGapH := 85;
end;
MemCanvas.Font.Size := 60;
end;
sOut := gAppHook.Helper.sPrintWaterTxt;
if _nFontSize = 0 then
begin
_nFontSize := MemCanvas.Font.Size;
while True do
begin
if _nFontSize > 200 then
break;
// if MemCanvas.TextWidth(sOut) > 3000 then // 부서명이 들어간 후 2000에서 변경
if MemCanvas.TextHeight(sOut) > 180 then // 부서명이 들어간 후 2000에서 변경
begin
Dec(_nFontSize);
break;
end;
Inc(_nFontSize);
MemCanvas.Font.Size := _nFontSize;
end;
end;
MemCanvas.Font.Size := _nFontSize - (_nFontSize div 3);
// sOut := IntToStr(MemCanvas.Font.Size) + ' - ' + sOut;
try
if gAppHook.Helper.bSmallFont_ then
begin
// 브라우저등의 경우... 폰트 크기를 가늠할수가 없다.
// 그래서 아래처럼 이미지로 처리 23_1017 13:10:40 kku
// var bmpText: TBitmap;
// Guard(bmpText, TBitmap.Create);
// bmpText.PixelFormat := pf4bit;
// bmpText.Canvas.Font.Assign(MemCanvas.Font);
// bmpText.Canvas.Font.Size := 12;
// bmpText.Canvas.Brush.Color := clWhite;
//// bmpText.Canvas.Brush.Style := bsClear;
//// bmpText.font
// sText := '모두의 보안, 실천은 나로부터';
// bmpText.SetSize(bmpText.Canvas.TextWidth(sText), bmpText.Canvas.TextHeight(sText));
// bmpText.Canvas.TextOut(0, 0, sText);
// MemCanvas.Draw(nW - bmpText.Width + nGapW + nGapW2, nH - bmpText.Height + nGapH + nGapH2, bmpText);
// 음..브라우저에서 상하단 문구 제거 23_1017 13:26:47 kku
end else begin
// var sDocInfo: String := 'c:\ProgramData\HE\Task\$TEST.txt';
// begin
// if FileExists(sDocInfo) then
// begin
// var StrList: TStringList;
// Guard(StrList, TStringList.Create);
// StrList.LoadFromFile(sDocInfo, TEncoding.UTF8);
// DeleteFile(sDocInfo);
// if StrList.Text <> '' then
// begin
// sText := StrList.Text;
// MemCanvas.TextOut(nGapW - MemCanvas.TextWidth(sText), nGapH, Format('%s', [sText]));
// end;
// end;
// end;
var bmpText: TBitmap;
var rcText: TRect;
// 우측 상단
if _sLabelName <> '' then
begin
Guard(bmpText, CreateTextBmp(_sLabelName));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := 0;
rcText.Bottom := bmpText.Height + 1;
// MemCanvas.Draw(nW - bmpText.Width, 0, bmpText);
MemCanvas.StretchDraw(rcText, bmpText); // 이렇게 해야 프린터에서 인식함.. 24_0108 14:25:59 kku
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(_sLabelName) + nGapW, nGapH, _sLabelName);
end;
// 우측 하단
begin
// Guard(bmpText, CreateTextBmp('작은 습관으로 시작되는 보안'));
Guard(bmpText, CreateTextBmp('모두의 보안, 실천은 나로부터')); // 변경 25_0616 15:05:45 kku
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nW - bmpText.Width + nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - bmpText.Height;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// 왜인지는 모르겠지만.. 아래 텍스트와는 다르게 세로 갭을 넣을 필요가 없다... (winword.exe) 23_1211 16:10:21 kku
// MemCanvas.Draw(nW - bmpText.Width + nGapW, nH - bmpText.Height, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
// sText := Format('px=%d, 모두의 보안, 실천은 나로부터', [MemCanvas.Font.PixelsPerInch]);
// sText := '모두의 보안, 실천은 나로부터';
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
// nH - MemCanvas.TextHeight(sText) + nGapH, sText);
end;
//
MemCanvas.Font.Size := _nFontSize div 4;
// 좌측 하단
begin
sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - (bmpText.Height * 2);
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(nGapW, nH - (bmpText.Height * 2), bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
begin
sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := nGapW;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := nH - bmpText.Height - 5;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(nGapW, nH - bmpText.Height - 5, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
sText := '';
if gAppHook.Helper.CtrlOpt.sDeptName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sDeptName, '/');
if gAppHook.Helper.CtrlOpt.sUName <> '' then
SumString(sText, gAppHook.Helper.CtrlOpt.sUName, '/');
SumString(sText, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), '/');
// 좌측 상단
begin
Guard(bmpText, CreateTextBmp(sText));
ZeroMemory(@rcText, SizeOf(rcText));
rcText.Left := 0;
rcText.Right := rcText.Left + bmpText.Width + 1;
rcText.Top := 0;
rcText.Bottom := rcText.Top + bmpText.Height + 1;
// MemCanvas.Draw(0, 0, bmpText);
MemCanvas.StretchDraw(rcText, bmpText);
end;
// if nGapH = 85 then
// begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH - 65, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH - 65, sText);
// end else begin
// sText := '본 문서는 현대엔지니어링의 정보자산이며 본 문서에 대한 무단복제 및 무단도용은 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 2) + nGapH, sText);
// sText := 'This document or drawing is the property of Hyundai Engineering. Any reproduction or distribution of the materials without permission of Hyundai engineering is strictly prohibited.';
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText)) + nGapH, sText);
// end;
end;
// 워터마크 이미지 처리 23_1011 10:41:31 kku
sImgPath := ExtractFilePath(gAppHook.Helper.DllPath) + 'HWMJ.dat';
if FileExists(sImgPath) then
begin
if _bmpWaterP = nil then
begin
var jpg: TJPEGImage;
// Guard(jpg, TJPEGImage.Create);
jpg := TJPEGImage.Create;
jpg.LoadFromFile(sImgPath);
var bmpImg: TBitmap;
// Guard(bmpImg, TBitmap.Create);
bmpImg := TBitmap.Create;
bmpImg.Assign(jpg);
jpg.Free; // Free
// bmpImg.Canvas.Font.Name := 'Tahoma';
// bmpImg.Canvas.Font.Name := '돋음';
bmpImg.Canvas.Font.Assign(MemCanvas.Font);
bmpImg.Canvas.Font.Color := clSilver;
// bmpImg.Canvas.Font.Size := 40;
bmpImg.Canvas.Font.Size := _nFontSize - (_nFontSize div 2);
bmpImg.Canvas.Font.Style := bmpImg.Canvas.Font.Style + [fsBold];
//---
// sOut := '정보보호부문/2323308/10.177.15.123/2023-12-31';
// HEC 새로운 요구사항 반영 23_1121 10:22:09 kku
// bmpImg.Canvas.Font.Size := bmpImg.Canvas.Font.Size + 14;
// ScalePercentBmp(bmpImg, 120);
//---
nWW := bmpImg.Canvas.TextWidth(sOut);
if bmpImg.Width > nWW then
nWW := bmpImg.Width;
nHH := bmpImg.Height + bmpImg.Canvas.TextHeight(sOut);
_bmpWaterP := TBitmap.Create;
_bmpWaterP.Canvas.Font.Assign(bmpImg.Canvas.Font);
_bmpWaterP.PixelFormat := pf4bit;
_bmpWaterP.SetSize(nWW, nHH);
_bmpWaterP.Canvas.Brush.Color := clWhite;
_bmpWaterP.Canvas.Brush.Style := bsSolid;
_bmpWaterP.Canvas.FillRect(Rect(0, 0, _bmpWaterP.Width, _bmpWaterP.Height));
// _bmpWaterP.Canvas.Brush.Style := bsClear; // x
_bmpWaterP.Canvas.Draw((nWW div 2) - (bmpImg.Width div 2), 0, bmpImg);
_bmpWaterP.Canvas.TextOut(0, bmpImg.Height, sOut);
// _bmpWaterP.Canvas.TextOut(0, (_bmpWaterP.Height div 2) - (_bmpWaterP.Canvas.TextHeight(sOut) div 2), sOut);
bmpImg.Free; // Free
// RotateBitmap_STF(_bmpWaterP, -0.7, true, clWhite, 200);
RotateBitmap_PlgBlt(_bmpWaterP, -0.7, true, clWhite);
if not bStartPage then
begin
var ii: Integer;
var jj: Integer;
for ii := 0 to _bmpWaterP.Width - 1 do
for jj := 0 to _bmpWaterP.Height - 1 do
if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
if ((ii + jj) mod 4) = 0 then
_bmpWaterP.Canvas.Pixels[ii, jj] := clWhite
else
_bmpWaterP.Canvas.Pixels[ii, jj] := clSilver;
end;
// 이렇게 안줄이고 할수 있는데... 원본으로 할 경우 보안프린터에서 이상하게 찍힘 23_1212 15:13:35 kku
if gAppHook.Helper.bSmallFont_ then
ScalePercentBmp(_bmpWaterP, 10)
else
ScalePercentBmp(_bmpWaterP, 60);
_bmpWaterP.TransparentColor := clWhite;
_bmpWaterP.Transparent := true;
end;
if (_bmpWater = nil) and (_bmpWaterP <> nil) then
begin
// HEC 보안프린터에서 컬러 출력시 아래 부분이 검은색으로 찍히는 문제가 있다...
// 이렇게 크기를 반으로 줄이고 덮어쓸때 늘리면 해결됨... 23_1103 13:42:54 kku
var nIW: Integer := nW - (nW div 2);
var nIH: Integer := nH - (nH div 2);
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit;
// _bmpWater.SetSize(nW-1, nH-1); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.SetSize(nIW, nIH); // 크기를 똑같이 하면 StretchDraw() 이게 무시되서 1씩 줄임
_bmpWater.Canvas.Brush.Color := clRed;
_bmpWater.Canvas.Brush.Style := bsSolid;
_bmpWater.Canvas.FillRect(Rect(0, 0, _bmpWater.Width, _bmpWater.Height));
// _bmpWater.Canvas.Brush.Style := bsClear;
// bmpWater.SaveToFile('C:\Users\kkuzil\Desktop\출력테스트\1.bmp');
nX := (nIW div 2) - (_bmpWaterP.Width div 2);
nY := (nIH div 2) - (nIH div 3);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
nY := (nIH div 2) + (nIH div 10);
_bmpWater.Canvas.Draw(nX, nY, _bmpWaterP);
// c.Draw(nX, nY, bmpWater);
// BitBlt(DC, nX, nY, nWW, nHH, bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
//bmp.SaveToFile('C:\Users\kkuzil\Desktop\출력테스트\3.bmp');
_bmpWater.TransparentColor := clRed;
_bmpWater.Transparent := true;
end;
if bStartPage then
begin
// 왜인지는 모르겠지만... 워터마크 크기에 +1을 안해주면
// FinePrint, HEC 보안프린터에서 이미지 출력이 되지 않는다...23_1017 10:56:48 kku
nWW := _bmpWaterP.Width + 1;
nHH := _bmpWaterP.Height + 1;
// nWW := Round((nScalePercent / 100) * bmpWater.Width);
// nHH := Round((nScalePercent / 100) * bmpWater.Height);
nX := (nW div 2) - (nWW div 2);
nY := (nH div 2) - (nH div 3);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
nY := (nH div 2) + (nH div 10);
MemCanvas.StretchDraw(Rect(nX, nY, nX + nWW, nY + nHH), _bmpWaterP);
end else
if _bmpWater <> nil then
begin
// 이렇게 통짜로 적용해야 HEC 보안프린터- 메모장에서 색상 적용이 먹힌다
MemCanvas.StretchDraw(Rect(0, 0, nW, nH), _bmpWater);
{// 투명처리 일단.. 포기 24_0111 16:41:45 kku
var bm: TBitmap;
Guard(bm, TBitmap.Create);
bm.PixelFormat := pf32bit;
bm.SetSize(_bmpWater.Width, _bmpWater.Height);
TransparentBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height,
_bmpWater.Canvas.Handle, 0, 0, _bmpWater.Width, _bmpWater.Height, clRed);
SetBkMode(bm.Canvas.Handle, TRANSPARENT);
var bf: BLENDFUNCTION;
ZeroMemory(@bf, SizeOf(bf));
bf.AlphaFormat := 0; // 일반 비트맵 0, 32비트 비트맵 AC_SRC_ALPHA
bf.BlendFlags := 0; // 무조건 0
bf.BlendOp := AC_SRC_OVER; // AC_SRC_OVER
bf.SourceConstantAlpha := 200; // 투명도(투명 0 - 불투명 255)
// AlphaBlend(MemCanvas.Handle, 0, 0, nW, nH, bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, bf);
AlphaBlend(MemCanvas.Handle, 0, 0, bm.Width, bm.Height, bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, bf);
// BitBlt(MemCanvas.Handle, 0, 0, nW, nH, _bmpWater.Canvas.Handle, 0, 0, SRCCOPY);
}
end;
// MemCanvas.Font.Size := 40;
// MemCanvas.TextOut(nGapW, nH - (MemCanvas.TextHeight(sText) * 3) + nGapH + nGapH2, Format('W=%d, H=%d, X=%d, Y=%d, R=%d. B=%d', [nWW, nHH, nX, nY, nX + nWW, nY + nHH]));
end;
if bStartPage then
BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
finally
SetTextColor(MemCanvas.Handle, oldColor);
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
if bStartPage then // 필요없음
DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
SelectObject(DC, hOldFont);
end;
gAppHook.Log(Format('ProcessWartermark_HEC() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
end;
end;
end.

View File

@ -0,0 +1,242 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_JUVIS;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_JUVIS(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Convert;
function ProcessWartermark_JUVIS(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
// exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
// LogToReg('Step-1-excel', Format('W = %d, H = %d,', [nW, nH]));
end else
begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
// nX := GetDeviceCaps(DC, ASPECTX);
// nY := GetDeviceCaps(DC, ASPECTY);
// bStartPage := false;
Guard(MemCanvas, TCanvas.Create);
// if bStartPage then
// MemCanvas.Handle := CreateCompatibleDC(DC)
// else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// gAppHook.Log(Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// LogToReg('Step0', Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
// pen := CreatePen(PS_SOLID, 1, RGB(0, 255, 0));
// hOldBmp := SelectObject(MemCanvas.Handle, pen);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
// MemCanvas.Font.Orientation := 250;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
nGapW := 19;
nGapH := 17;
end;
nDefDivFont := 180;
end else
begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := 70;
end;
nDefDivFont := 190;
end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 180
else
MemCanvas.Font.Size := nH div 180;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
CtrlOpt := gAppHook.Helper.CtrlOpt;
// sText := CtrlOpt.sPrintWaterTxt;
with CtrlOpt do
begin
if CtrlOpt.sUName <> '' then
sText := Format('%s / %s / %s / %s', [sUName, sDeptName, sEmpNo, DateTimeToStr(Now)])
else if sDeptName <> '' then
sText := Format('%s / %s / %s', [sDeptName, sEmpNo, DateTimeToStr(Now)])
else
sText := Format('%s / %s', [sEmpNo, DateTimeToStr(Now)]);
end;
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clBlack;
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
nH - MemCanvas.TextHeight(sText) + nGapH, sText);
sText := gAppHook.Helper.sCurDocName_;
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if nW < nH then
MemCanvas.Font.Size := nW div (nDefDivFont div 5) // 가운데 폰트 크기 키우려면 숫자를 키우면 됨
else
MemCanvas.Font.Size := nH div (nDefDivFont div 5);
MemCanvas.Font.Style := MemCanvas.Font.Style + [fsBold];
if _bmpWater = nil then
begin
sText := 'JUVIS DIET';
_bmpWater := TBitmap.Create;
_bmpWater.SetSize(MemCanvas.TextWidth(sText), MemCanvas.TextHeight(sText));
_bmpWater.Canvas.Font.Assign(MemCanvas.Font);
_bmpWater.Canvas.Font.Color := clSilver;
_bmpWater.Canvas.TextOut(0, 0, sText);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
RotateBitmap_PlgBlt(_bmpWater, -0.8, true, clWhite);
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
// 회색
// cTrMatrix[0][0] := 0.299;
// cTrMatrix[0][1] := 0.299;
// cTrMatrix[0][2] := 0.299;
// cTrMatrix[1][0] := 0.587;
// cTrMatrix[1][1] := 0.587;
// cTrMatrix[1][2] := 0.587;
// cTrMatrix[2][0] := 0.114;
// cTrMatrix[2][1] := 0.114;
// cTrMatrix[2][2] := 0.114;
// cTrMatrix[3][3] := 0.26; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1.0;
// 위 처럼하면 컬러랑 흑백이 섞인 출력의 경우 흑백에 로고가 안찍히는 문제 확인됨 24_0805 16:02:28 kku
cTrMatrix[0][0] := 1;
cTrMatrix[1][1] := 1;
cTrMatrix[2][2] := 1;
cTrMatrix[3][3] := BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.26); // 투명도 1.0 ~ 0.22
// cTrMatrix[3][3] := 0.05; // 투명도 1.0 ~ 0.22
cTrMatrix[4][4] := 1;
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
// gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,310 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_KBIZ;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_KBIZ(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI;
function ProcessWartermark_KBIZ(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(dc, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
if bStartPage then // 이럴리 없겠지만 안전장치
exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
// nX := GetDeviceCaps(DC, ASPECTX);
// nY := GetDeviceCaps(DC, ASPECTY);
Guard(MemCanvas, TCanvas.Create);
// if bStartPage then
// MemCanvas.Handle := CreateCompatibleDC(DC)
// else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
// hbmp := CreateCompatibleBitmap(DC, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// gAppHook.Log(Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// LogToReg('Step0', Format('ProcessWartermark() - DocSize X=%d, Y=%d, W=%d, H=%d, dc=%d', [nX, nY, nW, nH, DC]));
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
// pen := CreatePen(PS_SOLID, 1, RGB(0, 255, 0));
// hOldBmp := SelectObject(MemCanvas.Handle, pen);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
// MemCanvas.Font.Orientation := 250;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
nGapW := 19;
nGapH := 17;
end;
nDefDivFont := 180;
end else
begin
// KBIZ에서는 제외, 아래 짤리는 현상이 확인됨 24_0801 15:47:28 kku
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := 30; // 70;
end;
nDefDivFont := 190;
end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 180
else
MemCanvas.Font.Size := nH div 180;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
CtrlOpt := gAppHook.Helper.CtrlOpt;
// sText := CtrlOpt.sPrintWaterTxt;
with CtrlOpt do
begin
// if CtrlOpt.sUName <> '' then
// sText := Format('%s / %s / %s / %s', [sUName, sDeptName, sEmpNo, DateTimeToStr(Now)])
// else if sDeptName <> '' then
// sText := Format('%s / %s / %s', [sDeptName, sEmpNo, DateTimeToStr(Now)])
// else
// sText := Format('%s / %s', [sEmpNo, DateTimeToStr(Now)]);
sText := Format('%s %s', [sEmpNo, FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
end;
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clSilver;
// MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
// nH - MemCanvas.TextHeight(sText) + nGapH, sText); // 오른쪽 하단
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText); // 왼쪽 하단
// sText := gAppHook.Helper.sCurDocName_;
// MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
// var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'KBIZ.dat';
// if FileExists(sImgPath) then
begin
try
// var jpg: TJPEGImage;
// Guard(jpg, TJPEGImage.Create);
// jpg.LoadFromFile(sImgPath);
// AppCtrlDefine.pas SetCtrlOpt()에 업체 등록해줘야 정상 동작함... 24_0731 15:01:57 kku
// var bmpTemp: TBitmap;
// Guard(bmpTemp, TBitmap.Create);
// bmpTemp := TBitmap.Create;
// bmpTemp.Assign(jpg);
// bmpTemp.PixelFormat := pf4bit;
sText := 'KBIZ';
_bmpWater := TBitmap.Create;
// _bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.Canvas.Font.Assign(MemCanvas.Font);
if nW < nH then
_bmpWater.Canvas.Font.Size := nW div (nDefDivFont div 5) // 가운데 폰트 크기 키우려면 숫자를 키우면 됨
else
_bmpWater.Canvas.Font.Size := nH div (nDefDivFont div 5);
_bmpWater.Canvas.Font.Style := MemCanvas.Font.Style + [fsBold];
_bmpWater.Canvas.Font.Color := clSilver;
// if gAppHook.Helper.bSmallFont_ then
// _bmpWater.SetSize(_bmpWater.Canvas.TextWidth(sText), _bmpWater.Canvas.TextHeight(sText))
// _bmpWater.SetSize(Round(_bmpWater.Canvas.TextWidth(sText) / 6.5), Round(_bmpWater.Canvas.TextHeight(sText) / 6.5))
// else
_bmpWater.SetSize(_bmpWater.Canvas.TextWidth(sText), _bmpWater.Canvas.TextHeight(sText));
_bmpWater.Canvas.TextOut(0, 0, sText);
// if gAppHook.Helper.bSmallFont_ then
// _bmpWater.SetSize(Round(bmpTemp.Width / 6.5), Round(bmpTemp.Height / 6.5))
// else
// _bmpWater.SetSize(bmpTemp.Width, bmpTemp.Height);
// _bmpWater.Canvas.StretchDraw(TRect.Create(0, 0, _bmpWater.Width, _bmpWater.Height), bmpTemp);
// var ii, jj: Integer;
// for ii := 0 to _bmpWater.Width - 1 do
// for jj := 0 to _bmpWater.Height - 1 do
// if _bmpWater.Canvas.Pixels[ii, jj] <> clWhite then
// _bmpWater.Canvas.Pixels[ii, jj] := clRed;
// for ii := 0 to _bmpWaterP.Width - 1 do
// for jj := 0 to _bmpWaterP.Height - 1 do
// if _bmpWaterP.Canvas.Pixels[ii, jj] <> clWhite then
// if ((ii + jj) mod 2) = 0 then
// _bmpWaterP.Canvas.Pixels[ii, jj] := clWhite
// else
// _bmpWaterP.Canvas.Pixels[ii, jj] := clRed;
// ScalePercentBmp(_bmpWater, 60);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
// 회색
// cTrMatrix[0][0] := 0.299;
// cTrMatrix[0][1] := 0.299;
// cTrMatrix[0][2] := 0.299;
// cTrMatrix[1][0] := 0.587;
// cTrMatrix[1][1] := 0.587;
// cTrMatrix[1][2] := 0.587;
// cTrMatrix[2][0] := 0.114;
// cTrMatrix[2][1] := 0.114;
// cTrMatrix[2][2] := 0.114;
// cTrMatrix[3][3] := 0.1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1.0;
// 위 처럼하면 컬러랑 흑백이 섞인 출력의 경우 흑백에 로고가 안찍히는 문제 확인됨 24_0805 16:02:28 kku
// cTrMatrix[0][0] := 1;
// cTrMatrix[1][1] := 1;
// cTrMatrix[2][2] := 1;
// cTrMatrix[3][3] := 1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
// 신도 복합기에서 회색 가까운 색으로 표현한다..
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.2); // 이게 더 회색에 가깝지만 투명도가 떨어짐
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.05); // 후지에서 가장 흐리게
// cTrMatrix := MakeColorMatrix(0.05, 0.05, 0.05, 0.05); // 0.05가 가장 흐리게, 신도에선 흑백출력시 안보임
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.05)
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.08);
// cTrMatrix[0][0] := 0.3;
// cTrMatrix[0][1] := 0.3;
// cTrMatrix[0][2] := 0.3;
// cTrMatrix[1][0] := 0.59;
// cTrMatrix[1][1] := 0.59;
// cTrMatrix[1][2] := 0.59;
// cTrMatrix[2][0] := 0.11;
// cTrMatrix[2][1] := 0.11;
// cTrMatrix[2][2] := 0.11;
// cTrMatrix[3][3] := 0.22; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, ny, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,176 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_KOCES;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_KOCES(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic;
function ProcessWartermark_KOCES(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nDPI,
nGapW, nGapH, nBtLimitW: Integer;
sText, sBottomText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
// LogToReg('KOCES-01', '');
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(dc, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
if bStartPage then // 이럴리 없겠지만 안전장치
exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
// LogToReg('KOCES-02', Format('W=%d, H=%d', [nW, nH]));
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
if nH > nW then
begin
nGapW := 19;
nGapH := 17;
end else begin
nGapW := 29;
nGapH := 23;
end;
end;
end else begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := 70;
end;
end;
if nW > nH then
nBtLimitW := Round(nW * 0.45)
else
nBtLimitW := Round(nW * 0.55);
sBottomText := '이 문서는 KOCES에서 출력한 문서입니다. 본 문서는 허가없이 외부로 반출 할 수 없습니다.';
if _nFontSize = 0 then
begin
_nFontSize := 1;
while True do
begin
MemCanvas.Font.Size := _nFontSize;
// if _nFontSize > 500 then
// break;
if MemCanvas.TextWidth(sBottomText) >= nBtLimitW then
break;
Inc(_nFontSize);
end;
end;
MemCanvas.Font.Size := _nFontSize;
// LogToReg('KOCES-03', '');
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
SetBkMode(MemCanvas.Handle, TRANSPARENT);
try
CtrlOpt := gAppHook.Helper.CtrlOpt;
with CtrlOpt do
begin
if CtrlOpt.sUName <> '' then
sText := Format('%s / %s / %s / %s', [sUName, sDeptName, sEmpNo, DateTimeToStr(Now)])
else if sDeptName <> '' then
sText := Format('%s / %s / %s', [sDeptName, sEmpNo, DateTimeToStr(Now)])
else
sText := Format('%s / %s', [sEmpNo, DateTimeToStr(Now)]);
end;
// sText := Format('%d-%d:%d-%d + ',[nW, nH, now, noh]) + sText;
MemCanvas.TextOut(nGapW, nGapH, sText);
// LogToReg('KOCES-04', sText);
MemCanvas.Font.Style := MemCanvas.Font.Style + [fsBold];
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sBottomText) + nGapW,
nH - MemCanvas.TextHeight(sBottomText) + nGapH, sBottomText);
// LogToReg('KOCES-05', sText);
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark_KOCES() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,182 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_KORENTAL;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_KORENTAL(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_KORENTAL(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nTextH,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 58;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 150
else
MemCanvas.Font.Size := nH div 150;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray;
// 왼쪽 상단
sText := gAppHook.Helper.sPrintWaterTxt;
MemCanvas.TextOut(nGapW, nGapH, sText);
// 가운데 하단
sText := '본 문서는 한국렌탈의 정보 자산이며 무단 반출 시 당사 사규와 관련 법규에 의해 제재를 받을 수 있습니다.';
MemCanvas.TextOut(nGapW + (nW div 2) - (MemCanvas.TextWidth(sText) div 2), nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.08));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,182 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SANKYO;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SANKYO(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_SANKYO(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nTextH,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 58;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 150
else
MemCanvas.Font.Size := nH div 150;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray;
// 왼쪽 상단
sText := gAppHook.Helper.sPrintWaterTxt;
MemCanvas.TextOut(nGapW, nGapH, sText);
// 가운데 하단
sText := '본 문서는 한국다이이찌산쿄의 정보자산이며, 본 문서의 무단 유출/복사/도용 시 당사 사규와 관련 법규에 의해 제재 받을 수 있습니다.';
MemCanvas.TextOut(nGapW + (nW div 2) - (MemCanvas.TextWidth(sText) div 2), nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.08));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,205 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SERVE1;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SERVE1(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_SERVE1(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nTextH,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 58;
// 기본 폰트 조절
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := $00686868; // 메모장등
MemCanvas.Font.Style := MemCanvas.Font.Style + [fsBold];
SetTextColor(DC, $00686868); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := $00686868;
sText := gAppHook.Helper.sPrintWaterTxt;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWaterP = nil then
begin
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.Canvas.Font.Assign(MemCanvas.Font);
_bmpWater.Canvas.Font.Name := 'Tahoma'; // 맑은 고딕';
if nW > nH then
_bmpWater.Canvas.Font.Size := nW div 310
else
_bmpWater.Canvas.Font.Size := nH div 310;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var nBW: Integer;
if _bmpWater.Canvas.TextWidth(sText) > _bmpWater.Width then
nBW := _bmpWater.Canvas.TextWidth(sText)
else
nBW := _bmpWater.Width;
_bmpWaterP := TBitmap.Create;
_bmpWaterP.Canvas.Font.Assign(_bmpWater.Canvas.Font);
_bmpWaterP.PixelFormat := pf4bit;
_bmpWaterP.SetSize(nBW + 10, _bmpWater.Canvas.TextHeight(sText) + _bmpWater.Height + 40);
_bmpWaterP.Canvas.Brush.Color := clWhite;
_bmpWaterP.Canvas.Brush.Style := bsSolid;
_bmpWaterP.Canvas.TextOut(0, _bmpWaterP.Height - _bmpWater.Canvas.TextHeight(sText), sText);
if _bmpWaterP.Width > _bmpWater.Width then
_bmpWaterP.Canvas.Draw(_bmpWaterP.Width - (_bmpWaterP.Width div 2) - (_bmpWater.Width div 2), 0, _bmpWater)
else
_bmpWaterP.Canvas.Draw(0, 0, _bmpWater);
RotateBitmap_PlgBlt(_bmpWaterP, -0.6, true, clWhite);
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWaterP, 40)
else
ScalePercentBmp(_bmpWaterP, 140);
end;
end;
if _bmpWaterP <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWaterP.Width div 2);
nY := (nH div 4) - (_bmpWaterP.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWaterP, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,218 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SHCI;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SHCI(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_SHCI(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 60;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 130
else
MemCanvas.Font.Size := nH div 130;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := $969696;
sText := '고객정보 무단 반출시 법적 제재를 받을 수 있으며, 모든 출력물은 모니터링 됩니다.';
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
nGapH, sText); // 오른쪽 상단
sText := gAppHook.Helper.sPrintWaterTxt;
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText); // 왼쪽 하단
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
// 회색
// cTrMatrix[0][0] := 0.299;
// cTrMatrix[0][1] := 0.299;
// cTrMatrix[0][2] := 0.299;
// cTrMatrix[1][0] := 0.587;
// cTrMatrix[1][1] := 0.587;
// cTrMatrix[1][2] := 0.587;
// cTrMatrix[2][0] := 0.114;
// cTrMatrix[2][1] := 0.114;
// cTrMatrix[2][2] := 0.114;
// cTrMatrix[3][3] := 0.1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1.0;
// 위 처럼하면 컬러랑 흑백이 섞인 출력의 경우 흑백에 로고가 안찍히는 문제 확인됨 24_0805 16:02:28 kku
// cTrMatrix[0][0] := 1;
// cTrMatrix[1][1] := 1;
// cTrMatrix[2][2] := 1;
// cTrMatrix[3][3] := 1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
// 신도 복합기에서 회색 가까운 색으로 표현한다..
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.2); // 이게 더 회색에 가깝지만 투명도가 떨어짐
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.05); // 후지에서 가장 흐리게
// cTrMatrix := MakeColorMatrix(0.05, 0.05, 0.05, 0.05); // 0.05가 가장 흐리게, 신도에선 흑백출력시 안보임
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.08));
// cTrMatrix[0][0] := 0.3;
// cTrMatrix[0][1] := 0.3;
// cTrMatrix[0][2] := 0.3;
// cTrMatrix[1][0] := 0.59;
// cTrMatrix[1][1] := 0.59;
// cTrMatrix[1][2] := 0.59;
// cTrMatrix[2][0] := 0.11;
// cTrMatrix[2][1] := 0.11;
// cTrMatrix[2][2] := 0.11;
// cTrMatrix[3][3] := 0.22; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,249 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SHSC;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SHSC(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_SHSC(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', Format('W = %d, H = %d,', [nW, nH]));
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
// if bStartPage then
// begin
// MemCanvas.Handle := CreateCompatibleDC(DC);
// end else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
// if gAppHook.Helper.bSmallFont_ then
// begin
// if Pos('PDF', UpperCase(_sPrtName)) = 0 then
// begin
// // 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
// nGapW := 19;
// nGapH := 17;
// end;
//
// nDefDivFont := 180;
//
// end else
// begin
// // KBIZ에서는 제외, 아래 짤리는 현상이 확인됨 24_0801 15:47:28 kku
// if gAppHook.Helper.bEndDocProc_ then
// begin
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 60;
// end;
//
// nDefDivFont := 190;
// end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 130
else
MemCanvas.Font.Size := nH div 130;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := $969696;
sText := '고객정보 무단 반출시 법적 제재를 받을 수 있으며, 모든 출력물은 모니터링 됩니다.';
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText); // 왼쪽 하단
sText := gAppHook.Helper.sPrintWaterTxt;
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText); // 오른쪽 하단
// sText := gAppHook.Helper.sCurDocName_;
// MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
// 회색
// cTrMatrix[0][0] := 0.299;
// cTrMatrix[0][1] := 0.299;
// cTrMatrix[0][2] := 0.299;
// cTrMatrix[1][0] := 0.587;
// cTrMatrix[1][1] := 0.587;
// cTrMatrix[1][2] := 0.587;
// cTrMatrix[2][0] := 0.114;
// cTrMatrix[2][1] := 0.114;
// cTrMatrix[2][2] := 0.114;
// cTrMatrix[3][3] := 0.1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1.0;
// 위 처럼하면 컬러랑 흑백이 섞인 출력의 경우 흑백에 로고가 안찍히는 문제 확인됨 24_0805 16:02:28 kku
// cTrMatrix[0][0] := 1;
// cTrMatrix[1][1] := 1;
// cTrMatrix[2][2] := 1;
// cTrMatrix[3][3] := 1; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
// 신도 복합기에서 회색 가까운 색으로 표현한다..
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.2); // 이게 더 회색에 가깝지만 투명도가 떨어짐
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.05); // 후지에서 가장 흐리게
// cTrMatrix := MakeColorMatrix(0.05, 0.05, 0.05, 0.05); // 0.05가 가장 흐리게, 신도에선 흑백출력시 안보임
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.11))
else
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.14));
// cTrMatrix[0][0] := 0.3;
// cTrMatrix[0][1] := 0.3;
// cTrMatrix[0][2] := 0.3;
// cTrMatrix[1][0] := 0.59;
// cTrMatrix[1][1] := 0.59;
// cTrMatrix[1][2] := 0.59;
// cTrMatrix[2][0] := 0.11;
// cTrMatrix[2][1] := 0.11;
// cTrMatrix[2][2] := 0.11;
// cTrMatrix[3][3] := 0.22; // 투명도 1.0 ~ 0.22
// cTrMatrix[4][4] := 1;
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,244 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SKEC;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SKEC(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_SKEC(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nSet,
nTextH1, nTextH2, nTextS1, nTextS2,
nGapW, nGapH, nFontSize: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC;
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := '돋음';//'HY헤드라인M';//'Tahoma';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 45;
// 기본 폰트 조절
// if nW > nH then
// MemCanvas.Font.Size := nW div 195
// else
// MemCanvas.Font.Size := nH div 195;
MemCanvas.Font.Size := 10;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := $00AEAEAE; // 메모장등
SetTextColor(DC, $00AEAEAE); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
if nW < nH then
nSet := nW
else
nSet := nH;
// 상단 문구 처리
sText := gAppHook.Helper.sPrintWaterTxt + ' 이 문서는 SK ecoplant 의 보안정책 및 관련 법령에 의해 보호를 받는 정보자산으로 승인 없는 열람, 복사, 수정, 배포를 금지합니다.';
nFontSize := MemCanvas.Font.Size;
nTextS1 := nFontSize;
while True do
begin
if MemCanvas.TextWidth(sText) >= nSet then
begin
nTextS1 := nFontSize - 1;
MemCanvas.Font.Size := nTextS1;
break;
end;
Inc(nFontSize);
MemCanvas.Font.Size := nFontSize;
end;
nTextH1 := MemCanvas.TextHeight(sText);
nY := nTextH1 + nGapH;
if nW < nH then
begin
MemCanvas.TextOut(nGapW, nY, gAppHook.Helper.sPrintWaterTxt);
sText := '이 문서는 SK ecoplant 의 보안정책 및 관련 법령에 의해 보호를 받는 정보자산으로 승인 없는 열람, 복사, 수정, 배포를 금지합니다.';
MemCanvas.TextOut(nW - nGapW - MemCanvas.TextWidth(sText), nY, sText);
end else begin
sText := gAppHook.Helper.sPrintWaterTxt + ' 이 문서는 SK ecoplant 의 보안정책 및 관련 법령에 의해 보호를 받는 정보자산으로 승인 없는 열람, 복사, 수정, 배포를 금지합니다.';
MemCanvas.TextOut(nGapW, nY, sText);
end;
// MemCanvas.TextOut(nGapW + (nW div 2) - (MemCanvas.TextWidth(sText) div 2), nY, sText);/
sText := 'This document is the informational asset protected by SK ecoplant security and law. Unauthorized access, copy, revision, distribution are strictly prohibited';
nFontSize := MemCanvas.Font.Size;
nTextS2 := nFontSize;
while True do
begin
if MemCanvas.TextWidth(sText) >= nSet then
begin
nTextS2 := nFontSize - 1;
MemCanvas.Font.Size := nTextS2;
break;
end;
Inc(nFontSize);
MemCanvas.Font.Size := nFontSize;
end;
nTextH2 := MemCanvas.TextHeight(sText);
// nY := MemCanvas.TextHeight(sText) + nGapH;
Inc(nY, nTextH2 + Round(nTextH2 / 2));
nFontSize := MemCanvas.Font.Size;
if nW < nH then
MemCanvas.TextOut(nGapW + (nW div 2) - (MemCanvas.TextWidth(sText) div 2), nY, sText)
else
MemCanvas.TextOut(nGapW, nY, sText);
// 하단 문구 처리
MemCanvas.Font.Size := nTextS1;
// nY := nH - (nTextH1 + nGapH) - (nTextH2 + Round(nTextH2 / 2));
nY := nH + nGapH - nTextH1 - (nTextH2 + Round(nTextH2 / 2));
if nW < nH then
begin
MemCanvas.TextOut(nGapW, nY, gAppHook.Helper.sPrintWaterTxt);
sText := '이 문서는 SK ecoplant 의 보안정책 및 관련 법령에 의해 보호를 받는 정보자산으로 승인 없는 열람, 복사, 수정, 배포를 금지합니다.';
MemCanvas.TextOut(nW - nGapW - MemCanvas.TextWidth(sText), nY, sText);
Inc(nY, nTextH2 + Round(nTextH2 / 2));
sText := 'This document is the informational asset protected by SK ecoplant security and law. Unauthorized access, copy, revision, distribution are strictly prohibited';
MemCanvas.TextOut(nGapW + (nW div 2) - (MemCanvas.TextWidth(sText) div 2), nY, sText);
end else begin
sText := gAppHook.Helper.sPrintWaterTxt + ' 이 문서는 SK ecoplant 의 보안정책 및 관련 법령에 의해 보호를 받는 정보자산으로 승인 없는 열람, 복사, 수정, 배포를 금지합니다.';
MemCanvas.TextOut(nGapW, nY, sText);
Inc(nY, nTextH2 + Round(nTextH2 / 2));
sText := 'This document is the informational asset protected by SK ecoplant security and law. Unauthorized access, copy, revision, distribution are strictly prohibited';
MemCanvas.TextOut(nGapW, nY, sText);
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// if gAppHook.Helper.CurAppType = catWebb then
// ScalePercentBmp(_bmpWater, 40)
// else
// ScalePercentBmp(_bmpWater, 140);
ScalePercentBmp(_bmpWater, 60);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.23))
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.25));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
SelectObject(MemCanvas.Handle, hOldBmp);
DeleteObject(hbmp);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,203 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_SOLMIX;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_SOLMIX(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Convert;
function ProcessWartermark_SOLMIX(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
CtrlOpt: TAppCtrlOpt;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
// exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
// LogToReg('Step-1-excel', Format('W = %d, H = %d,', [nW, nH]));
end else
begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
nGapW := 0;
nGapH := 0;
// SetBkMode(MemCanvas.Handle, TRANSPARENT);
// MemCanvas.Font.Orientation := 250;
MemCanvas.Font.Name := 'Tahoma';
if gAppHook.Helper.bSmallFont_ then
begin
if Pos('PDF', UpperCase(_sPrtName)) = 0 then
begin
// 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
nGapW := 19;
nGapH := 17;
end;
nDefDivFont := 180;
end else
begin
if gAppHook.Helper.bEndDocProc_ then
begin
if CompareText(gAppHook.ModuleName, 'winword.exe') = 0 then
nGapH := 70;
end;
nDefDivFont := 190;
end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 160
else
MemCanvas.Font.Size := nH div 160;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
MemCanvas.Font.Name := 'Segoe UI';//'Tahoma';
SetTextColor(DC, clGray); // 엑셀등
try
sText := gAppHook.Helper.sPrintWaterTxt + gAppHook.Helper.sCurDocName_;
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.TextOut(nGapW, nGapH, sText);
sText := gAppHook.Helper.sPrintWaterTxt + '이 문서는 솔믹스 보안 문서로서 무단 복사 및 외부 유출을 금합니다.';
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if nW < nH then
MemCanvas.Font.Size := nW div Round(nDefDivFont / 4.5) // 가운데 폰트 크기 키우려면 숫자를 키우면 됨
else
MemCanvas.Font.Size := nH div Round(nDefDivFont / 4.5);
// MemCanvas.Font.Style := MemCanvas.Font.Style + [fsBold];
if _bmpWater = nil then
begin
sText := gAppHook.Helper.CtrlOpt.sEmpNo;
_bmpWater := TBitmap.Create;
_bmpWater.SetSize(MemCanvas.TextWidth(sText), MemCanvas.TextHeight(sText));
_bmpWater.Canvas.Font.Assign(MemCanvas.Font);
_bmpWater.Canvas.Font.Color := clGray;
_bmpWater.Canvas.TextOut(0, 0, sText);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
RotateBitmap_PlgBlt(_bmpWater, -0.8, true, clWhite);
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
// 위 처럼하면 컬러랑 흑백이 섞인 출력의 경우 흑백에 로고가 안찍히는 문제 확인됨 24_0805 16:02:28 kku
cTrMatrix[0][0] := 1;
cTrMatrix[1][1] := 1;
cTrMatrix[2][2] := 1;
cTrMatrix[3][3] := BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.22); // 투명도 1.0 ~ 0.22
// cTrMatrix[3][3] := 0.05; // 투명도 1.0 ~ 0.22
cTrMatrix[4][4] := 1;
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
// gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,372 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_WELFND;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_WELFND(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
procedure DrawRotatedText(Canvas: TCanvas; X, Y, Angle: Integer; const Text: string);
var
LogFont: TLogFont;
OldFont, RotatedFont: HFONT;
begin
// 기존 폰트를 기반으로 로그폰트 가져오기
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
// 회전 각도 설정 (0.1도 단위, 즉 450 = 45도)
LogFont.lfEscapement := Angle * 10;
LogFont.lfOrientation := Angle * 10;
// 안티앨리어싱 등 품질 향상 옵션
LogFont.lfQuality := ANTIALIASED_QUALITY;
// 회전 폰트 생성
RotatedFont := CreateFontIndirect(LogFont);
OldFont := SelectObject(Canvas.Handle, RotatedFont);
// 텍스트 출력
TextOut(Canvas.Handle, X, Y, PChar(Text), Length(Text));
// 자원 정리
SelectObject(Canvas.Handle, OldFont);
DeleteObject(RotatedFont);
end;
function ProcessWartermark_WELFND(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 60;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 160
else
MemCanvas.Font.Size := nH div 160;
oldColor := GetTextColor(DC);
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray;
SetTextColor(DC, clGray);
sText := gAppHook.Helper.sPrintWaterTxt;
// 좌측 상단
MemCanvas.TextOut(nGapW, nGapH, sText);
// 우측 상단
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
nGapH, sText);
// 좌측 하단
MemCanvas.TextOut(nGapW, nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// 왼쪽 위 대각선
// DrawRotatedText(MemCanvas, nGapW + (nW div 8), nGapH + (nH div 5), -45, sText);
// 오른쪽 아래 대각선
// DrawRotatedText(MemCanvas, nGapW + (nW div 2) + (nW div 5), nGapH + (nH div 2) + (nH div 5), -45, sText);
if nW > nH then
MemCanvas.Font.Size := nW div 130
else
MemCanvas.Font.Size := nH div 130;
// 우측 하단
sText := '본 문서에 대한 소유권은 회사에 있으며, 무단으로 반출 시 법적 책임을 받게 됩니다.';
MemCanvas.TextOut(nW - MemCanvas.TextWidth(sText) + nGapW,
nH - MemCanvas.TextHeight(sText) + nGapH, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if _bmpWater = nil then
// begin
// var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
// if FileExists(sImgPath) then
// begin
// try
// _bmpWater := TBitmap.Create;
// _bmpWater.PixelFormat := pf32bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
// _bmpWater.SetSize(nW, nH);
// _bmpWater.TransparentColor := clWhite;
// _bmpWater.Transparent := true;
//
// var bmp: TBitmap;
// Guard(bmp, TBitmap.Create);
// bmp.LoadFromFile(sImgPath);
// _bmpWater.Canvas.Draw((_bmpWater.Width div 2) - (bmp.Width div 2),
// (_bmpWater.Height div 2) - (bmp.Height div 2), bmp);
//
//
// if _bmpWaterP = nil then
// begin
// sText := gAppHook.Helper.sPrintWaterTxt;
// try
// _bmpWaterP := TBitmap.Create;
// _bmpWaterP.PixelFormat := pf32bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
// _bmpWaterP.Canvas.Font.Assign(MemCanvas.Font);
// _bmpWaterP.Canvas.Font.Color := $D8D8D8; // clGray;
// _bmpWaterP.Canvas.Font.Size := 12;
// _bmpWaterP.TransparentColor := clWhite;
// _bmpWaterP.Transparent := true;
//
// var nTW: Integer := _bmpWaterP.Canvas.TextWidth(sText);
// _bmpWaterP.SetSize(nTW, nTW);
//
// DrawRotatedText(_bmpWaterP.Canvas, _bmpWaterP.Canvas.TextHeight(sText), 0, -45, sText);
// except
// // ..
// end;
// end;
//
// if _bmpWaterP <> nil then
// begin
// LogToReg('_bmpWaterP - 01', '');
// var cTrMatrix: TColorMatrix;
// ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
//
// if gAppHook.Helper.bSmallFont_ then
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
// else
// // cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.1));
//
// // 왼쪽 위 대각선
// // DrawRotatedText(MemCanvas, nGapW + (nW div 8), nGapH + (nH div 5), -45, sText);
//
// // 오른쪽 아래 대각선
// // DrawRotatedText(MemCanvas, nGapW + (nW div 2) + (nW div 5), nGapH + (nH div 2) + (nH div 5), -45, sText);
//
// if not gAppHook.Helper.IsExcel or
// ( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
// ( gAppHook.Helper.IsExcel and not bStartPage ) then
// begin
// nX := nW div 13;
// nY := nH div 8;
// DrawBitmapWaterEx(_bmpWater.Canvas.Handle, nX, nY, _bmpWaterP, @cTrMatrix);
//
// nX := nW div 3;
// nY := nH div 3;
// DrawBitmapWaterEx(_bmpWater.Canvas.Handle, nX, nY, _bmpWaterP, @cTrMatrix);
// end;
// end;
// except
// // ..
// end;
// end;
// end;
//
// if _bmpWater <> nil then
// begin
// var cTrMatrix: TColorMatrix;
// ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
//
// if gAppHook.Helper.bSmallFont_ then
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
// else
//// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, 0.0099);
// cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05));
//
// if not gAppHook.Helper.IsExcel or
// ( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
// ( gAppHook.Helper.IsExcel and not bStartPage ) then
// begin
// DrawBitmapWaterEx2(MemCanvas.Handle, 0, 0, _bmpWater, @cTrMatrix);
// end;
// end;
// 사선 텍스트
if _bmpWaterP = nil then
begin
sText := gAppHook.Helper.sPrintWaterTxt;
try
_bmpWaterP := TBitmap.Create;
_bmpWaterP.PixelFormat := pf32bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
// _bmpWaterP.SetSize(nW, nH);
_bmpWaterP.Canvas.Font.Assign(MemCanvas.Font);
_bmpWaterP.Canvas.Font.Color := $D8D8D8; // clGray;
_bmpWaterP.Canvas.Font.Size := 50;
_bmpWaterP.TransparentColor := clWhite;
_bmpWaterP.Transparent := true;
// LogToReg('TW', IntToStr(_bmpWaterP.Canvas.TextWidth(sText)));
// LogToReg('TH', IntToStr(_bmpWaterP.Canvas.TextHeight(sText)));
var nTW: Integer := _bmpWaterP.Canvas.TextWidth(sText);
// var dx: Integer := Round(_bmpWaterP.Canvas.TextHeight(sText) * Sin(45));
// var dy: Integer := Round(_bmpWaterP.Canvas.TextWidth(sText) * Sin(45));
_bmpWaterP.SetSize(nTW, nTW);
// _bmpWaterP.SetSize(500, 500);
DrawRotatedText(_bmpWaterP.Canvas, _bmpWaterP.Canvas.TextHeight(sText), 0, -45, sText);
except
// ..
end;
end;
if _bmpWaterP <> nil then
begin
LogToReg('_bmpWaterP - 01', '');
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.1));
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
nX := Round(nW / 7);
nY := Round(nH / 4.8);
DrawBitmapWaterEx3(MemCanvas.Handle, nX, nY, _bmpWaterP, @cTrMatrix);
nX := Round(nW / 1.5);
nY := Round(nH / 1.5);
LogToReg('_bmpWaterP - 02', Format('W=%d, H=%d, X=%d, Y=%d', [nW, nH, nX, nY]));
DrawBitmapWaterEx3(MemCanvas.Handle, nX, nY, _bmpWaterP, @cTrMatrix);
end;
end;
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf32bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
_bmpWater.LoadFromFile(sImgPath);
ScalePercentBmp(_bmpWater, 300);
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 2) - (_bmpWater.Width div 2);
nY := (nH div 2) - (_bmpWater.Height div 2);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx3(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end; 
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,219 @@
{*******************************************************}
{ }
{ ProcessWatermark }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ProcessWM_WINSTN;
interface
uses
Winapi.Windows, System.Classes, Vcl.Graphics;
function ProcessWartermark_WINSTN(DC: HDC; bStartPage: Boolean = true): Boolean;
implementation
uses
AppCtrlDefine, ApiHookPrint, BS1Hook, Tocsg.Safe, System.SysUtils, Condition,
Tocsg.Graphic, Winapi.GDIPAPI, Tocsg.Strings, Vcl.Imaging.jpeg, Tocsg.Trace,
Tocsg.Convert;
function ProcessWartermark_WINSTN(DC: HDC; bStartPage: Boolean = true): Boolean;
var
nW, nH, i, nX, nY, nTextH,
nGapW, nGapH, nDefDivFont: Integer;
sText: String;
MemCanvas: TCanvas;
hbmp, hOldBmp: HBITMAP;
pen: HPEN;
oldColor: TColor;
r: TRect;
begin
Result := true;
if _PrtDC <> DC then
exit;
SaveDC(DC);
gAppHook.Helper.bIsWaterMaking_ := true;
try
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', 'Step-0');
try
if gAppHook.Helper.IsExcel then
begin
// 클리핑 제거 25_0605 14:51:11 kku
SelectClipRgn(DC, 0);
// 엑셀은 출력시트 설정에 따라 전체 영역으로 잡히는 않는 현상이 있다.. 24_0805 13:46:31 kku
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end else begin
// if bStartPage then // 이럴리 없겠지만 안전장치
// exit;
ZeroMemory(@r, SizeOf(r));
GetClipBox(DC, r);
nW := r.Width;
nH := r.Height;
// LogToReg('Step-1', Format('W = %d, H = %d,', [nW, nH]));
// LogToReg('Step-2', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', Format('W = %d, H = %d,', [nW, nH]));
// WriteLnFileEndUTF8('C:\ProgramData\HE\prt.log', Format('W = %d, H = %d,', [GetDeviceCaps(DC, HORZRES), GetDeviceCaps(DC, VERTRES)]));
if nW = 0 then
nW := GetDeviceCaps(DC, HORZRES); // 세로모드 : 4961, 가로모드 : 7016, 크로미움 프린트 인쇄시 4760
if nH = 0 then
nH := GetDeviceCaps(DC, VERTRES); // 세로모드 : 7016, 가로모드 : 4961, 크로미움 프린트 인쇄시 6814
end;
Guard(MemCanvas, TCanvas.Create);
// if bStartPage then
// begin
// MemCanvas.Handle := CreateCompatibleDC(DC);
// end else
MemCanvas.Handle := DC; //CreateCompatibleDC(DC);
hbmp := CreateCompatibleBitmap(MemCanvas.Handle, nW, nH);
hOldBmp := SelectObject(MemCanvas.Handle, hbmp);
// if bStartPage then
// PatBlt(MemCanvas.Handle, 0, 0, nW, nH, WHITENESS);
nGapW := 0;
nGapH := 0;
MemCanvas.Font.Name := 'Tahoma';
// if gAppHook.Helper.bSmallFont_ then
// begin
// if Pos('PDF', UpperCase(_sPrtName)) = 0 then
// begin
// // 일반 프린터에서만 밀리는 현상이 있어서 갭을 준다.. 24_0627 10:52:33 kku
// nGapW := 19;
// nGapH := 17;
// end;
//
// nDefDivFont := 180;
//
// end else
// begin
// // KBIZ에서는 제외, 아래 짤리는 현상이 확인됨 24_0801 15:47:28 kku
// if gAppHook.Helper.bEndDocProc_ then
// begin
if (CompareText(gAppHook.ModuleName, 'winword.exe') = 0) or
(CompareText(gAppHook.ModuleName, 'notepad++.exe') = 0) then
nGapH := 45;
// end;
//
// nDefDivFont := 190;
// end;
// 기본 폰트 조절
if nW > nH then
MemCanvas.Font.Size := nW div 190
else
MemCanvas.Font.Size := nH div 190;
oldColor := GetTextColor(DC);
// 폰트색 지정... 프로그램에 따라 지정되는 설정이 다르다
MemCanvas.Font.Color := clGray; // 메모장등
SetTextColor(DC, clGray); // 엑셀등
try
SetBkMode(MemCanvas.Handle, TRANSPARENT);
MemCanvas.Font.Color := clGray;
// 왼쪽 하단
sText := gAppHook.Helper.sCurDocName_ + ' / ' + gAppHook.Helper.sPrintWaterTxt;
nTextH := MemCanvas.TextHeight(sText);
nY := nH - nTextH + nGapH;
MemCanvas.TextOut(nGapW, nY, sText);
Dec(nY, nTextH + (nTextH div 3));
sText := 'This document is property of the WINSTECHNET And may not be modlfied, copled or distributed without prior consent of the WINSTECHNET';
MemCanvas.TextOut(nGapW, nY, sText);
Dec(nY, nTextH + (nTextH div 3));
sText := '이 문서는 ㈜윈스테크넷의 자산입니다.';
MemCanvas.TextOut(nGapW, nY, sText);
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
if _bmpWater = nil then
begin
var sImgPath: String := ExtractFilePath(gAppHook.Helper.DllPath) + 'CI.bmp';
if FileExists(sImgPath) then
begin
try
_bmpWater := TBitmap.Create;
_bmpWater.PixelFormat := pf4bit; // 이거 켜면 흑백 출력시 안됨 24_0807 15:52:56 kku
_bmpWater.LoadFromFile(sImgPath);
// LogToReg('BW-01', BooleanToStr(gAppHook.Helper.CurAppType = catWebb, 'YES', 'NO'));
if gAppHook.Helper.CurAppType = catWebb then
ScalePercentBmp(_bmpWater, 40)
else
ScalePercentBmp(_bmpWater, 140);
_bmpWater.TransparentColor := clWhite;
_bmpWater.Transparent := true;
// _bmpWater.SaveToFile('C:\Users\kku\Desktop\이전 바탕화면\출력 추출 데이터\1.bmp');
except
// ..
end;
end;
end;
if _bmpWater <> nil then
begin
var cTrMatrix: TColorMatrix;
ZeroMemory(@cTrMatrix, SizeOf(cTrMatrix));
if gAppHook.Helper.bSmallFont_ then
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.05))
else
cTrMatrix := MakeColorMatrix(0.2, 0.2, 0.2, BooleanToFloat(gAppHook.Helper.CtrlOpt.fWmTran <> 0.0, gAppHook.Helper.CtrlOpt.fWmTran, 0.08));
Dec(nW, nGapW);
Dec(nH, nGapH);
nX := (nW div 4) - (_bmpWater.Width div 2);
nY := (nH div 4) - (_bmpWater.Height div 2);
// MemCanvas.Draw(nX, nY, _bmpWater);
if not gAppHook.Helper.IsExcel or
( gAppHook.Helper.IsExcel and bStartPage and not _bDoStartProc) or
( gAppHook.Helper.IsExcel and not bStartPage ) then
begin
DrawBitmapWaterEx(MemCanvas.Handle, nX, nY, _bmpWater, @cTrMatrix);
end;
end;
// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
// if bStartPage then
// BitBlt(DC, 0, 0, nW, nH, MemCanvas.Handle, 0, 0, SRCCOPY);
SelectObject(MemCanvas.Handle, hOldBmp);
// DeleteObject(pen);
DeleteObject(hbmp);
// if bStartPage then
// DeleteDC(MemCanvas.Handle);
MemCanvas.Handle := 0;
finally
SetTextColor(DC, oldColor);
end;
gAppHook.Log(Format('ProcessWartermark() - Completed, LastError=%d', [GetLastError]));
except
// 실패하면 출력 안되게 해준다 22_0907 14:28:52 kku
Result := false;
DeleteDC(DC);
end;
finally
gAppHook.Helper.bIsWaterMaking_ := false;
RestoreDC(DC, -1);
end;
end;
end.

View File

@ -0,0 +1,140 @@
library eCrmHeHelper;
uses
System.SysUtils,
Winapi.Windows,
System.Classes,
Tocsg.DllEntry in '..\..\Tocsg.Lib\VCL\Tocsg.DllEntry.pas',
Tocsg.CommonData in '..\..\Tocsg.Lib\VCL\Tocsg.CommonData.pas',
Tocsg.Obj in '..\..\Tocsg.Lib\VCL\Tocsg.Obj.pas',
Tocsg.Trace in '..\..\Tocsg.Lib\VCL\Tocsg.Trace.pas',
Tocsg.Safe in '..\..\Tocsg.Lib\VCL\Tocsg.Safe.pas',
Tocsg.Path in '..\..\Tocsg.Lib\VCL\Tocsg.Path.pas',
Tocsg.Files in '..\..\Tocsg.Lib\VCL\Tocsg.Files.pas',
Tocsg.DateTime in '..\..\Tocsg.Lib\VCL\Tocsg.DateTime.pas',
Tocsg.Encrypt in '..\..\Tocsg.Lib\VCL\Tocsg.Encrypt.pas',
Tocsg.Thread in '..\..\Tocsg.Lib\VCL\Tocsg.Thread.pas',
Tocsg.Strings in '..\..\Tocsg.Lib\VCL\Tocsg.Strings.pas',
Tocsg.Hex in '..\..\Tocsg.Lib\VCL\Tocsg.Hex.pas',
Tocsg.Json in '..\..\Tocsg.Lib\VCL\Tocsg.Json.pas',
Tocsg.ClientBase in '..\..\Tocsg.Lib\VCL\CS\Tocsg.ClientBase.pas',
Tocsg.Packet in '..\..\Tocsg.Lib\VCL\CS\Tocsg.Packet.pas',
Tocsg.Win32 in '..\..\Tocsg.Lib\VCL\Tocsg.Win32.pas',
Tocsg.Process in '..\..\Tocsg.Lib\VCL\Tocsg.Process.pas',
Tocsg.WTS in '..\..\Tocsg.Lib\VCL\Tocsg.WTS.pas',
Tocsg.Kernel32 in '..\..\Tocsg.Lib\VCL\Tocsg.Kernel32.pas',
Tocsg.Shell in '..\..\Tocsg.Lib\VCL\Tocsg.Shell.pas',
Tocsg.Service in '..\..\Tocsg.Lib\VCL\Tocsg.Service.pas',
Tocsg.Registry in '..\..\Tocsg.Lib\VCL\Tocsg.Registry.pas',
Tocsg.FileInfo in '..\..\Tocsg.Lib\VCL\Tocsg.FileInfo.pas',
Tocsg.WndUtil in '..\..\Tocsg.Lib\VCL\Tocsg.WndUtil.pas',
Tocsg.WinInfo in '..\..\Tocsg.Lib\VCL\Tocsg.WinInfo.pas',
Tocsg.Exception in '..\..\Tocsg.Lib\VCL\Tocsg.Exception.pas',
Tocsg.Network in '..\..\Tocsg.Lib\VCL\Tocsg.Network.pas',
Tocsg.Driver in '..\..\Tocsg.Lib\VCL\Tocsg.Driver.pas',
Tocsg.Convert in '..\..\Tocsg.Lib\VCL\Tocsg.Convert.pas',
Tocsg.Disk in '..\..\Tocsg.Lib\VCL\Tocsg.Disk.pas',
Tocsg.WMI in '..\..\Tocsg.Lib\VCL\Tocsg.WMI.pas',
Tocsg.Printer in '..\..\Tocsg.Lib\VCL\Tocsg.Printer.pas',
Tocsg.PacketDefine in '..\..\Tocsg.Lib\VCL\CS\Tocsg.PacketDefine.pas',
Tocsg.Process.IPC in '..\..\Tocsg.Lib\VCL\Tocsg.Process.IPC.pas',
Tocsg.Param in '..\..\Tocsg.Lib\VCL\Tocsg.Param.pas',
Tocsg.DRM.Encrypt in '..\..\Tocsg.Module\TocsgDRM\LIB_Common\Tocsg.DRM.Encrypt.pas',
superobject in '..\..\Tocsg.Lib\VCL\SuperObject\superobject.pas',
aes_type in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_type.pas',
aes_cbc in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_cbc.pas',
BTypes in '..\..\Tocsg.Lib\VCL\EncLib\AES\BTypes.pas',
AES_Base in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Base.pas',
AES_Encr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Encr.pas',
AES_Decr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Decr.pas',
Tocsg.Binary in '..\..\Tocsg.Lib\VCL\Tocsg.Binary.pas',
Tocsg.Hash in '..\..\Tocsg.Lib\VCL\Tocsg.Hash.pas',
EM.Tocsg.hash in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.hash.pas',
EM.Tocsg.Sha1 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.Sha1.pas',
EM.MD5 in '..\..\Tocsg.Lib\VCL\EncLib\EM.MD5.pas',
EM.CRC32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.CRC32.pas',
EM.Tocsg.sha256 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.sha256.pas',
EM.GSStorage in '..\..\Tocsg.Lib\VCL\Other\EM.GSStorage.pas',
EM.nduWlanAPI in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanAPI.pas',
EM.nduCType in '..\..\Tocsg.Lib\VCL\Other\EM.nduCType.pas',
EM.nduL2cmn in '..\..\Tocsg.Lib\VCL\Other\EM.nduL2cmn.pas',
EM.nduWlanTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanTypes.pas',
EM.nduWinDot11 in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinDot11.pas',
EM.nduWinNT in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinNT.pas',
EM.nduEapTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduEapTypes.pas',
EM.nduNtDDNdis in '..\..\Tocsg.Lib\VCL\Other\EM.nduNtDDNdis.pas',
EM.WbemScripting_TLB in '..\..\Tocsg.Lib\VCL\Other\EM.WbemScripting_TLB.pas',
EM.WinOSVersion in '..\..\Tocsg.Lib\VCL\Other\EM.WinOSVersion.pas',
EM.winioctl in '..\..\Tocsg.Lib\VCL\Other\EM.winioctl.pas',
EM.WtsApi32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.WtsApi32.pas',
DDetours in '..\..\EM.Lib\DDetours\DDetours-master\Source\DDetours.pas',
LegacyTypes in '..\..\EM.Lib\DDetours\DDetours-master\Source\LegacyTypes.pas',
InstDecode in '..\..\EM.Lib\DDetours\DDetours-master\Source\InstDecode.pas',
CPUID in '..\..\EM.Lib\DDetours\DDetours-master\Source\CPUID.pas',
EM.DelphiZXingQRCode in '..\..\Tocsg.Lib\VCL\Other\EM.DelphiZXingQRCode.pas',
BS1Hook in 'BS1Hook.pas',
GlobalDefine in '..\LIB_Common\GlobalDefine.pas',
DefineHelper in '..\EXE_eCrmHeHelper\DefineHelper.pas',
AppCtrlDefine in '..\..\Tocsg.Module\AppCtrl\LIB_Common\AppCtrlDefine.pas',
ApiHookDraw in '..\..\Tocsg.Module\AppCtrl\DLL_AppCtrl\ApiHookDraw.pas',
ApiHookFile in '..\..\Tocsg.Module\AppCtrl\DLL_AppCtrl\ApiHookFile.pas',
ApiHookPrint in '..\..\Tocsg.Module\AppCtrl\DLL_AppCtrl\ApiHookPrint.pas',
AppHookClient in '..\..\Tocsg.Module\AppCtrl\DLL_AppCtrl\AppHookClient.pas',
Define in 'Define.pas',
Condition in '..\LIB_Common\Condition.pas',
Tocsg.Graphic in '..\..\Tocsg.Lib\VCL\Tocsg.Graphic.pas',
ProcessWM_Custom in 'PrintWatermark\ProcessWM_Custom.pas',
ProcessWM_Def in 'PrintWatermark\ProcessWM_Def.pas',
ProcessWM_GEC in 'PrintWatermark\ProcessWM_GEC.pas',
ProcessWM_SOLMIX in 'PrintWatermark\ProcessWM_SOLMIX.pas',
ProcessWM_KBIZ in 'PrintWatermark\ProcessWM_KBIZ.pas',
ProcessWM_KOCES in 'PrintWatermark\ProcessWM_KOCES.pas',
ProcessWM_SERVE1 in 'PrintWatermark\ProcessWM_SERVE1.pas',
ProcessWM_SHSC in 'PrintWatermark\ProcessWM_SHSC.pas',
ProcessWM_DEMO in 'PrintWatermark\ProcessWM_DEMO.pas',
ProcessWM_SKEC in 'PrintWatermark\ProcessWM_SKEC.pas',
ApiHookExplorer in '..\..\Tocsg.Module\AppCtrl\DLL_AppCtrl\ApiHookExplorer.pas',
ProcessWM_HEC in 'PrintWatermark\ProcessWM_HEC.pas',
ProcessWM_SHCI in 'PrintWatermark\ProcessWM_SHCI.pas',
ProcessWM_KORENTAL in 'PrintWatermark\ProcessWM_KORENTAL.pas',
ProcessWM_WELFND in 'PrintWatermark\ProcessWM_WELFND.pas',
ProcessWM_JUVIS in 'PrintWatermark\ProcessWM_JUVIS.pas',
ProcessWM_SANKYO in 'PrintWatermark\ProcessWM_SANKYO.pas',
ProcessWM_WINSTN in 'PrintWatermark\ProcessWM_WINSTN.pas';
{$R *.res}
var
BS1Hook: TBS1Hook = nil;
procedure DLLEntryPoint(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH :
begin
BS1Hook := TBS1Hook.Create;
end;
DLL_PROCESS_DETACH :
begin
try
if Assigned(BS1Hook) then
FreeAndNil(BS1Hook);
except
//
end;
end;
end;
end;
begin
DllProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,204 @@
object DlgSvcInstMain: TDlgSvcInstMain
Left = 0
Top = 0
BorderStyle = bsSingle
Caption = #49436#48708#49828' '#49444#52824'/'#51228#44144' ('#53580#49828#53944' '#50857')'
ClientHeight = 315
ClientWidth = 489
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Position = poScreenCenter
TextHeight = 13
object Label1: TLabel
Left = 31
Top = 23
Width = 70
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = #49436#48708#49828' '#51060#47492' :'
end
object Label2: TLabel
Left = 31
Top = 50
Width = 70
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = #54364#49884' '#51060#47492' :'
end
object Label3: TLabel
Left = 31
Top = 77
Width = 65
Height = 13
Caption = #49436#48708#49828' '#44221#47196' :'
end
object Label4: TLabel
Left = 31
Top = 104
Width = 70
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = #49436#48708#49828' '#50976#54805' :'
end
object Label5: TLabel
Left = 31
Top = 131
Width = 70
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = #49884#51089' '#50976#54805' :'
end
object Label6: TLabel
Left = 31
Top = 158
Width = 70
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = #49436#48708#49828' '#49345#53468' :'
end
object lbStatus: TLabel
Left = 119
Top = 158
Width = 44
Height = 13
Caption = #50508#49688#50630#51020
end
object edSvcName: TEdit
Left = 119
Top = 20
Width = 337
Height = 21
ImeName = 'Microsoft IME 2010'
TabOrder = 0
end
object edDisplayName: TEdit
Left = 119
Top = 47
Width = 337
Height = 21
ImeName = 'Microsoft IME 2010'
TabOrder = 1
end
object edPath: TEdit
Left = 119
Top = 74
Width = 337
Height = 21
ImeName = 'Microsoft IME 2010'
TabOrder = 2
end
object cbSvcType: TComboBox
Left = 119
Top = 101
Width = 210
Height = 21
Style = csDropDownList
ImeName = 'Microsoft IME 2010'
TabOrder = 3
OnChange = cbSvcTypeChange
Items.Strings = (
'SERVICE_KERNEL_DRIVER'
'SERVICE_FILE_SYSTEM_DRIVER'
'SERVICE_ADAPTER'
'SERVICE_RECOGNIZER_DRIVER'
'SERVICE_DRIVER'
'SERVICE_WIN32_OWN_PROCESS'
'SERVICE_WIN32_SHARE_PROCESS'
'SERVICE_WIN32'
'SERVICE_INTERACTIVE_PROCESS')
end
object cbStartType: TComboBox
Left = 119
Top = 128
Width = 210
Height = 21
Style = csDropDownList
ImeName = 'Microsoft IME 2010'
TabOrder = 4
Items.Strings = (
'SERVICE_BOOT_START'
'SERVICE_SYSTEM_START'
'SERVICE_AUTO_START'
'SERVICE_DEMAND_START'
'SERVICE_DISABLED')
end
object btnStatus: TButton
Left = 25
Top = 269
Width = 75
Height = 25
Caption = #49345#53468
TabOrder = 5
OnClick = btnStatusClick
end
object btnInstall: TButton
Left = 118
Top = 269
Width = 75
Height = 25
Caption = #49444#52824
TabOrder = 6
OnClick = btnInstallClick
end
object btnDelete: TButton
Left = 388
Top = 269
Width = 75
Height = 25
Caption = #51228#44144
TabOrder = 7
OnClick = btnDeleteClick
end
object btnStart: TButton
Left = 209
Top = 269
Width = 75
Height = 25
Caption = #49884#51089
TabOrder = 8
OnClick = btnStartClick
end
object btnStop: TButton
Left = 297
Top = 269
Width = 75
Height = 25
Caption = #51473#51648
TabOrder = 9
OnClick = btnStopClick
end
object chInstallStart: TCheckBox
Left = 31
Top = 225
Width = 210
Height = 17
Caption = #49436#48708#49828#47484' '#49444#52824' '#54980' '#49884#51089#54616#44172' '#54633#45768#45796'.'
TabOrder = 10
end
object chStayOnTop: TCheckBox
Left = 366
Top = 225
Width = 97
Height = 17
Caption = #54637#49345' '#52572#49345#50948
TabOrder = 11
OnClick = chStayOnTopClick
end
object chInteractive: TCheckBox
Left = 31
Top = 192
Width = 210
Height = 17
Caption = #49436#48708#49828#50752' '#45936#49828#53356#53681' '#49345#54840' '#51089#50857' '#54728#50857
TabOrder = 12
end
end

View File

@ -0,0 +1,358 @@
unit DSvcInstMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
const
INI_CONFIG = 'ServiceInstall.ini';
type
TDlgSvcInstMain = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
edSvcName: TEdit;
edDisplayName: TEdit;
edPath: TEdit;
cbSvcType: TComboBox;
cbStartType: TComboBox;
btnStatus: TButton;
btnInstall: TButton;
btnDelete: TButton;
Label6: TLabel;
lbStatus: TLabel;
btnStart: TButton;
btnStop: TButton;
chInstallStart: TCheckBox;
chStayOnTop: TCheckBox;
chInteractive: TCheckBox;
procedure btnInstallClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnStatusClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure chStayOnTopClick(Sender: TObject);
procedure cbSvcTypeChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure SaveInput;
procedure LoadInput;
procedure UpdateStatus;
end;
var
DlgSvcInstMain: TDlgSvcInstMain;
implementation
uses
Tocsg.Service, Tocsg.Controls, Winapi.WinSvc, System.IniFiles, Tocsg.Safe,
Tocsg.Path;
{$R *.dfm}
Constructor TDlgSvcInstMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
LoadInput;
UpdateStatus;
end;
Destructor TDlgSvcInstMain.Destroy;
begin
Inherited;
end;
procedure TDlgSvcInstMain.SaveInput;
var
ini: TIniFile;
begin
Guard(ini, TIniFile.Create(GetRunExePathDir + INI_CONFIG));
ini.WriteString('RecentInfo', 'Name', edSvcName.Text);
ini.WriteString('RecentInfo', 'Display', edDisplayName.Text);
ini.WriteString('RecentInfo', 'Path', edPath.Text);
ini.WriteInteger('RecentInfo', 'Type', cbSvcType.ItemIndex);
ini.WriteInteger('RecentInfo', 'Mode', cbStartType.ItemIndex);
ini.WriteBool('RecentInfo', 'InstallAfter', chInstallStart.Checked);
end;
procedure TDlgSvcInstMain.LoadInput;
var
sPath: String;
ini: TIniFile;
begin
sPath := GetRunExePathDir + INI_CONFIG;
if FileExists(sPath) then
begin
Guard(ini, TIniFile.Create(sPath));
edSvcName.Text := ini.ReadString('RecentInfo', 'Name', '');
edDisplayName.Text := ini.ReadString('RecentInfo', 'Display', '');
edPath.Text := ini.ReadString('RecentInfo', 'Path', '');
cbSvcType.ItemIndex := ini.ReadInteger('RecentInfo', 'Type', -1);
cbStartType.ItemIndex := ini.ReadInteger('RecentInfo', 'Mode', -1);
chInstallStart.Checked := ini.ReadBool('RecentInfo', 'InstallAfter', false);
Application.ProcessMessages;
end;
end;
procedure TDlgSvcInstMain.btnDeleteClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '서비스 이름을 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '존재하지 않는 서비스입니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,
SERVICE_START_PENDING :
if not ServiceStop(edSvcName.Text) then
begin
MessageBox(Handle, '서비스를 중지하는중 실패하였습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
end;
if UninstallService(edSvcName.Text) then
begin
MessageBox(Handle, '서비스 제거에 성공하였습니다.', PChar(Caption), MB_ICONINFORMATION or MB_OK);
SaveInput;
UpdateStatus;
end else
MessageBox(Handle, '서비스 제거에 실패하였습니다.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnInstallClick(Sender: TObject);
var
dwSvcType: DWORD;
nStartMode: Integer;
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '서비스 이름을 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
if edDisplayName.Text = '' then
begin
MessageBox(Handle, '표시 이름을 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edDisplayName.SetFocus;
exit;
end;
if edPath.Text = '' then
begin
MessageBox(Handle, '서비스 경로를 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edPath.SetFocus;
exit;
end;
if not FileExists(edPath.Text) then
begin
MessageBox(Handle, '경로에 서비스 파일이 존재하지 않습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
edPath.SetFocus;
exit;
end;
if cbSvcType.ItemIndex = -1 then
begin
MessageBox(Handle, '서비스 유형을 선택해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbSvcType.SetFocus;
exit;
end;
if cbStartType.ItemIndex = -1 then
begin
MessageBox(Handle, '시작 유형을 선택해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbStartType.SetFocus;
exit;
end;
case cbSvcType.ItemIndex of
0 : dwSvcType := SERVICE_KERNEL_DRIVER;
1 : dwSvcType := SERVICE_FILE_SYSTEM_DRIVER;
2 : dwSvcType := SERVICE_ADAPTER;
3 : dwSvcType := SERVICE_RECOGNIZER_DRIVER;
4 : dwSvcType := SERVICE_DRIVER;
5 : dwSvcType := SERVICE_WIN32_OWN_PROCESS;
6 : dwSvcType := SERVICE_WIN32_SHARE_PROCESS;
7 : dwSvcType := SERVICE_WIN32;
8 : dwSvcType := SERVICE_INTERACTIVE_PROCESS;
else begin
MessageBox(Handle, '잘못된 서비스 유형입니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbSvcType.SetFocus;
exit;
end;
end;
case dwSvcType of
5, 6 :
if chInteractive.Checked then
dwSvcType := dwSvcType or SERVICE_INTERACTIVE_PROCESS;
end;
case cbStartType.ItemIndex of
0 : nStartMode := SERVICE_BOOT_START;
1 : nStartMode := SERVICE_SYSTEM_START;
2 : nStartMode := SERVICE_AUTO_START;
3 : nStartMode := SERVICE_DEMAND_START;
4 : nStartMode := SERVICE_DISABLED;
else begin
MessageBox(Handle, '잘못된 시작 유형입니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbStartType.SetFocus;
exit;
end;
end;
if InstallService(edSvcName.Text, edPath.Text, edDisplayName.Text,
dwSvcType, nStartMode) then
begin
MessageBox(Handle, '설치를 성공하였습니다.', PChar(Caption), MB_ICONINFORMATION or MB_OK);
if chInstallStart.Checked then
if not ServiceStart(edSvcName.Text) then
MessageBox(Handle, '서비스 시작중 오류가 발생하였습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
SaveInput;
UpdateStatus;
end else
MessageBox(Handle, '설치에 실패하였습니다.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnStartClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '서비스 이름을 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '서비스가 설치되어 있지 않습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,
SERVICE_START_PENDING :
begin
MessageBox(Handle, '이미 시작중 입니다..', PChar(Caption), MB_ICONINFORMATION or MB_OK);
exit;
end;
end;
if ServiceStart(edSvcName.Text) then
UpdateStatus
else
MessageBox(Handle, '서비스 시작을 실패하였습니다.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnStopClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '서비스 이름을 입력해 주십시오.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '서비스가 설치되어 있지 않습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_STOPPED,
SERVICE_STOP_PENDING :
begin
MessageBox(Handle, '이미 중지중 입니다..', PChar(Caption), MB_ICONINFORMATION or MB_OK);
exit;
end;
end;
if ServiceStop(edSvcName.Text) then
UpdateStatus
else
MessageBox(Handle, '서비스 중지를 실패하였습니다.', PChar(Caption), MB_ICONWARNING or MB_OK);
end;
procedure TDlgSvcInstMain.cbSvcTypeChange(Sender: TObject);
begin
case cbSvcType.ItemIndex of
5, 6 : chInteractive.Enabled := true;
else chInteractive.Enabled := false;
end;
end;
procedure TDlgSvcInstMain.chStayOnTopClick(Sender: TObject);
begin
if chStayOnTop.Checked then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;
end;
procedure TDlgSvcInstMain.btnStatusClick(Sender: TObject);
begin
UpdateStatus;
end;
procedure TDlgSvcInstMain.UpdateStatus;
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
exit;
case GetServiceStatus(edSvcName.Text) of
SERVICE_STOPPED : lbStatus.Caption := '중지됨. (SERVICE_STOPPED)';
SERVICE_START_PENDING : lbStatus.Caption := '시작 하는중.. (SERVICE_START_PENDING)';
SERVICE_STOP_PENDING : lbStatus.Caption := '중지 하는중.. (SERVICE_STOP_PENDING)';
SERVICE_RUNNING : lbStatus.Caption := '시작됨. (SERVICE_RUNNING)';
SERVICE_CONTINUE_PENDING : lbStatus.Caption := '진행중.. (SERVICE_CONTINUE_PENDING)';
SERVICE_PAUSE_PENDING : lbStatus.Caption := '정지 하는중.. (SERVICE_PAUSE_PENDING)';
SERVICE_PAUSED : lbStatus.Caption := '정지됨. (SERVICE_PAUSED)';
else lbStatus.Caption := '설치되어 있지 않음.';
end;
Application.ProcessMessages;
end;
end.

File diff suppressed because one or more lines are too long

View File

@ -0,0 +1,16 @@
program ServiceInst;
uses
Vcl.Forms,
DSvcInstMain in 'DSvcInstMain.pas' {DlgSvcInstMain};
{$R *.res}
begin
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TDlgSvcInstMain, DlgSvcInstMain);
Application.Run;
end.

View File

@ -0,0 +1,159 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{419F1935-FE39-4FD3-9AB5-A50274A9865A}</ProjectGuid>
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>ServiceInst.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<ProjectName Condition="'$(ProjectName)'==''">ServiceInst</ProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\_OUT_Object\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\OUT_$(Config) - $(Platform)</DCC_ExeOutput>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;WinApi;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<SanitizedProjectName>ServiceInst</SanitizedProjectName>
<VerInfo_Locale>1042</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>PKIEDB16;vcldbx;PKIECtrl16;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;acntDelphiXE2_R;svnui;DBXSybaseASEDriver;vclimg;ZMstr191DXE2;frxDB16;intrawebdb_120_160;fmi;fs16;TeeUI;vclactnband;FMXTee;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;bdertl;VirtualTreesR;adortl;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<Manifest_File>..\..\Tocsg.Module\kkuProject.manifest</Manifest_File>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>none</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>TeeDB;vclib;Tee;DBXOdbcDriver;DBXSybaseASEDriver;vclimg;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;DBXDb2Driver;websnap;VclSmp;vcl;DataSnapConnectors;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;adortl;$(DCC_UsePackage)</DCC_UsePackage>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_MapFile>3</DCC_MapFile>
<DCC_Define>EUREKALOG;EUREKALOG_VER7;$(DCC_Define)</DCC_Define>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<BT_BuildType>Debug</BT_BuildType>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DSvcInstMain.pas">
<Form>DlgSvcInstMain</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1042</VersionInfo>
<VersionInfo Name="CodePage">949</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k280.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp280.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">ServiceInst.dpr</Source>
</Source>
</Delphi.Personality>
<Deployment Version="5"/>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

After

Width:  |  Height:  |  Size: 62 KiB

View File

@ -0,0 +1,449 @@
unit ServiceRunDLL;
interface
uses
Winapi.Windows, Winapi.WinSvc, System.SysUtils, System.Classes,
System.Math, System.Win.Registry,Vcl.SvcMgr;
procedure ServiceMain(Argc: DWord; Argv: PLPWSTR); stdcall;
procedure InstallServices_dll(Silent: BOOL; dwSvcType, dwSvcStart: DWORD); stdcall;
procedure UnInstallServices_dll(Silent: BOOL); stdcall;
implementation
uses
Tocsg.Trace, System.UITypes, Vcl.Dialogs, Vcl.Consts;
{$IFNDEF WIN64}
type
TIsWow64Process = function(hProcess: THandle;var bWow64Proc: Boolean): Boolean; stdcall;
function IsWow64: Boolean;
var
h: THandle;
b: Boolean;
fnIsWow64Process: TIsWow64Process;
begin
Result := false;
h := GetModuleHandle('kernel32');
if h = 0 then
exit;
try
fnIsWow64Process := GetProcAddress(h, 'IsWow64Process');
if @fnIsWow64Process = nil then
exit;
if fnIsWow64Process(GetCurrentProcess, b) = true then
Result := b;
finally
FreeLibrary(h);
end;
end;
{$ENDIF}
function GetModuleName(): String;
begin
SetLength(Result, MAX_PATH);
GetModuleFileName(hInstance, PChar(Result), Length(Result));
SetLength(Result, StrLen(PChar(Result)));
end;
type
TServiceApplicationDerr = class (TServiceApplication);
procedure ServiceMain(Argc: DWord; Argv: PLPWSTR); stdcall;
begin
TTgTrace.T('DLL ServiceMain called. Argc %d', [Argc]);
TTgTrace.T('CmdLine: ' + GetCommandLine);
TTgTrace.T('Module: ' + GetModuleName());
TServiceApplicationDerr(Vcl.SvcMgr.Application).DispatchServiceMain(Argc, Argv);
end;
type
TRegistryHelper = class helper for TRegistry
public
function ReadMultiSz(const name: string; var Strings: TStrings): boolean;
function WriteMultiSz(const name: string; const value: TStrings): boolean;
end;
function TRegistryHelper.ReadMultiSz(const name: string; var Strings: TStrings): boolean;
var
iSizeInByte: integer;
Buffer: array of WChar;
iWCharsInBuffer: integer;
z: integer;
sString: string;
begin
iSizeInByte := GetDataSize(name);
if iSizeInByte > 0 then begin
SetLength(Buffer, Floor(iSizeInByte / sizeof(WChar)));
iWCharsInBuffer := Floor(ReadBinaryData(name, Buffer[0],
iSizeInByte) / sizeof(WChar));
sString := '';
for z := 0 to iWCharsInBuffer do begin
if Buffer[z] <> #0 then
begin
sString := sString + Buffer[z];
end else
begin
if sString <> '' then begin
Strings.Append(sString);
sString := '';
end;
end;
end;
result := true;
end else begin
result := false;
end;
end;
function TRegistryHelper.WriteMultiSz(const name: string; const value: TStrings): boolean;
var
sContent: string;
x: integer;
begin
sContent := '';
for x := 0 to pred(value.Count) do begin
sContent := sContent + value.Strings[x] + #0;
end;
sContent := sContent + #0;
result := RegSetValueEx(CurrentKey, pchar(name), 0, REG_MULTI_SZ,
pointer(sContent), Length(sContent)*sizeof(Char)) = 0;
end;
function RegisterServices(Install, Silent: Boolean;
dwSvcType: DWORD = DWORD(-1); dwSvcStart: DWORD = DWORD(-1)): Boolean;
procedure InstallService(Service: TService; SvcMgr: SC_HANDLE);
var
TmpTagID: DWORD;
PTag: PDWORD;
PSSN: PChar;
Svc: SC_HANDLE;
Path: string;
function GetNTServiceType: DWORD;
const
NTServiceType: array[TServiceType] of DWORD = ( SERVICE_WIN32_OWN_PROCESS,
SERVICE_KERNEL_DRIVER, SERVICE_FILE_SYSTEM_DRIVER);
begin
with Service do
begin
Result := NTServiceType[Service.ServiceType];
if (ServiceType = stWin32) and Interactive then
Result := Result or SERVICE_INTERACTIVE_PROCESS;
if (ServiceType = stWin32) and (Vcl.SvcMgr.Application.ServiceCount > 1) then
Result := (Result xor SERVICE_WIN32_OWN_PROCESS) or SERVICE_WIN32_SHARE_PROCESS;
end;
end;
function GetNTStartType: DWORD;
const
NTStartType: array[TStartType] of DWORD = (SERVICE_BOOT_START,
SERVICE_SYSTEM_START, SERVICE_AUTO_START, SERVICE_DEMAND_START,
SERVICE_DISABLED);
begin
with Service do
begin
Result := NTStartType[StartType];
if (StartType in [stBoot, stSystem]) and (ServiceType <> stDevice) then
Result := SERVICE_AUTO_START;
end;
end;
function GetNTErrorSeverity: DWORD;
const
NTErrorSeverity: array[TErrorSeverity] of DWORD = (SERVICE_ERROR_IGNORE,
SERVICE_ERROR_NORMAL, SERVICE_ERROR_SEVERE, SERVICE_ERROR_CRITICAL);
begin
Result := NTErrorSeverity[Service.ErrorSeverity];
end;
function GetNTDependencies: String;
var
I, Len: Integer;
P: PChar;
begin
Result := '';
Len := 0;
with Service do
begin
for i := 0 to Dependencies.Count - 1 do
begin
Inc(Len, Length(Dependencies[i].Name) + 1); // For null-terminator
if Dependencies[i].IsGroup then Inc(Len);
end;
if Len <> 0 then
begin
Inc(Len); // For final null-terminator;
SetLength(Result, Len);
P := @Result[1];
for i := 0 to Dependencies.Count - 1 do
begin
if Dependencies[i].IsGroup then
begin
P^ := SC_GROUP_IDENTIFIER;
Inc(P);
end;
P := StrECopy(P, PChar(Dependencies[i].Name));
Inc(P);
end;
P^ := #0;
end;
end;
end;
procedure SetSvcHostParameters();
var
Reg: TRegistry;
StrList: TStringList;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
// 이 서비스의 Parameters 기록
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\services\' + Service.Name + '\Parameters', true) then
begin
Reg.WriteExpandString('ServiceDll', GetModuleName());
Reg.WriteInteger('ServiceDllUnloadOnStop', 1); // 서비스 정지시 svchost가 이 DLL을 놓도록 한다.
Reg.CloseKey();
end;
// svchost 의 엔트리포인트 기록
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Svchost', false) then
begin
StrList:= TStringList.Create;
try
StrList.Text := Service.Name;
Reg.WriteMultiSz(Service.Name, StrList);
finally
StrList.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
begin
with Service do
begin
{$IFDEF WIN64}
Path := '%SystemRoot%\system32\svchost.exe -k ' + Name;
{$ELSE}
if IsWow64 then
begin
Path := '%SystemRoot%\SysWOW64\svchost.exe -k ' + Name;
end else
begin
Path := '%SystemRoot%\system32\svchost.exe -k ' + Name;
end;
{$ENDIF}
if Assigned(BeforeInstall) then BeforeInstall(Service);
TmpTagID := TagID;
if TmpTagID > 0 then PTag := @TmpTagID else PTag := nil;
if ServiceStartName = '' then
PSSN := nil
else
PSSN := PChar(ServiceStartName);
if dwSvcType = DWORD(-1) then
dwSvcType := GetNTServiceType;
if dwSvcStart = DWORD(-1) then
dwSvcStart := GetNTStartType;
Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName),
SERVICE_ALL_ACCESS, dwSvcType, dwSvcStart, GetNTErrorSeverity,
PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies),
PSSN, PChar(Password));
TagID := TmpTagID;
if Svc = 0 then
RaiseLastOSError;
// Parameters 키 생성. 정보 적재.
SetSvcHostParameters();
try
try
if Assigned(AfterInstall) then AfterInstall(Service);
except
on E: Exception do
begin
DeleteService(Svc);
raise;
end;
end;
finally
CloseServiceHandle(Svc);
end;
end;
end;
procedure UninstallService(Service: TService; SvcMgr: SC_HANDLE);
var
Svc: SC_HANDLE;
Reg: TRegistry;
procedure RemSvcHostParameters();
begin
// svchost 의 엔트리포인트 제거
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Svchost', false) then
begin
//ShowMessage('엔트리 키오픈 성공. 제거 시작');
Reg.DeleteValue(Service.Name);
Reg.CloseKey();
end;
// 이 서비스의 Parameters 제거
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\services\' + Service.Name, false) then
begin
//ShowMessage('파라미터 키 오픈 성공. 제거 시작');
Reg.DeleteKey('Parameters');
Reg.CloseKey();
end;
finally
Reg.Free;
end;
end;
begin
with Service do
begin
if Assigned(BeforeUninstall) then BeforeUninstall(Service);
//ShowMessage('서비스 제거 ' + Service.Name);
RemSvcHostParameters();
Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS);
if Svc = 0 then RaiseLastOSError;
try
if not DeleteService(Svc) then RaiseLastOSError;
finally
CloseServiceHandle(Svc);
end;
if Assigned(AfterUninstall) then AfterUninstall(Service);
end;
end;
procedure DisplayMessage(const Msg: string; const MsgType: TMsgDlgType);
begin
if IsConsole then
WriteLn(Msg)
else
MessageDlg(Msg, MsgType, [mbOk], 0);
end;
var
SvcMgr: SC_HANDLE;
Msg: string;
i: Integer;
begin
Result := True;
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SvcMgr = 0 then RaiseLastOSError;
with Vcl.SvcMgr.Application do
try
for i := 0 to ComponentCount - 1 do
if Components[i] is TService then
try
if Install then
InstallService(TService(Components[i]), SvcMgr)
else
UninstallService(TService(Components[i]), SvcMgr)
except
on E: Exception do
begin
Result := False;
if (not Silent) then
begin
if Install then
Msg := SServiceInstallFailed
else
Msg := SServiceUninstallFailed;
with TService(Components[i]) do
DisplayMessage(Format(Msg, [DisplayName, E.Message]), mtError);
end;
end;
end;
if Result and not Silent then
if Install then
DisplayMessage(SServiceInstallOK, mtInformation)
else
DisplayMessage(SServiceUninstallOK, mtInformation);
finally
CloseServiceHandle(SvcMgr);
end;
end;
procedure InstallServices_dll(Silent: BOOL; dwSvcType, dwSvcStart: DWORD); stdcall;
begin
try
RegisterServices(true, Silent, dwSvcType, dwSvcStart);
except
end;
end;
procedure UnInstallServices_dll(Silent: BOOL); stdcall;
var
bRetry: Boolean;
nReCnt: Integer;
Label
LB_Retry;
begin
LB_Retry :
bRetry := false;
try
RegisterServices(false, Silent);
except
on E: EOSError do
begin
if E.ErrorCode = 5 then
bRetry := true
else
exit;
end;
on E: Exception do
exit;
end;
if bRetry then
begin
Inc(nReCnt);
if nReCnt > 5 then
exit;
Sleep(1000);
goto LB_Retry;
end;
end;
end.

View File

@ -0,0 +1,9 @@
object SvBs1Rcvr: TSvBs1Rcvr
DisplayName = 'tgbs1 helper'
Interactive = True
OnExecute = ServiceExecute
OnPause = ServicePause
OnStop = ServiceStop
Height = 138
Width = 257
end

View File

@ -0,0 +1,447 @@
unit SvcBs1Rcvr;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;
type
TSvBs1Rcvr = class(TService)
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
function CreateEnvironmentBlock(var lpEnvironment: Pointer;
hToken: THandle;
bInherit: BOOL): BOOL; stdcall; external 'userenv.dll';
var
SvBs1Rcvr: TSvBs1Rcvr;
implementation
uses
{$IFDEF DEBUG}
Tocsg.Trace,
{$ENDIF}
Tocsg.Win32, GlobalDefine, Tocsg.Path, Tocsg.Process, Tocsg.Safe, Tocsg.WTS,
Tocsg.Kernel32, Tocsg.Shell, Tocsg.Service, Winapi.WinSvc, Tocsg.Registry;
{$R *.dfm}
function _ExecuteAppAsUser(dwFollowPID: DWORD; sPath, sParam: String; dwVisible: DWORD): TProcessInformation;
type
TOKEN_MANDATORY_LABEL = record
Label_: SID_AND_ATTRIBUTES;
end;
const
DEFWINSTATION = 'WinSta0';
DEFDESKTOP = 'Default';
WINLOGON = 'Winlogon';
SCREENSAVER = 'Screen-Saver';
WHITESPACE = ' '{SPACE}+chr(9){TAB}+chr(10){LF};
DOMUSERSEP = '\';
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwCreateFlag: DWORD;
pEnvBlock: Pointer;
hProc, hToken, hNewToken: THandle;
TIL: TOKEN_MANDATORY_LABEL;
begin
ZeroMemory(@Result, SizeOf(Result));
ZeroMemory(@ProcessInfo, SizeOf(TProcessInformation));
ZeroMemory(@TIL, SizeOf(TIL));
hToken := 0;
hNewToken := 0;
if dwFollowPID = 0 then
begin
{$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. FollowPID is null..'); {$ENDIF}
exit;
end;
// hProc := OpenProcess(PROCESS_ALL_ACCESS, false, dwFollowPID);
hProc := OpenProcess(MAXIMUM_ALLOWED, false, dwFollowPID);
if hProc = 0 then
begin
{$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. OpenProcess() - Fail... Error=%d', [GetLastError]); {$ENDIF}
exit;
end;
try
// if OpenProcessToken(hProc, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE, hToken) then
if OpenProcessToken(hProc, MAXIMUM_ALLOWED, hToken) then
begin
// if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil,
if DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil,
SecurityImpersonation, TokenPrimary, hNewToken) then
begin
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.lpDesktop := DEFWINSTATION + '\' + DEFDESKTOP;
// StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USEPOSITION; // SW_HIDE등을 적용 시키려면 이걸 활성화 시켜줘야 한다 (용성 찾음) 15_0521 sunk
StartupInfo.wShowWindow := dwVisible;
dwCreateFlag := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE;
pEnvBlock := nil;
CreateEnvironmentBlock(pEnvBlock, hNewToken, true);
if pEnvBlock <> nil then
dwCreateFlag := dwCreateFlag or CREATE_UNICODE_ENVIRONMENT;
if CreateProcessAsUserW(hNewToken,
nil,//PWideChar(ExtractFileName(sPath)),
PWideChar(Format('"%s" %s', [sPath, sParam])),
nil,
nil,
false,
dwCreateFlag,
pEnvBlock,
nil,//PWideChar(ExtractFilePath(sPath)),
StartupInfo,
ProcessInfo) then
begin
Result := ProcessInfo;
end else
{$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. CreateProcessAsUserW() - Fail... Error=%d', [GetLastError]); {$ENDIF}
end;
end else
{$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. OpenProcessToken() - Fail... Error=%d', [GetLastError]); {$ENDIF}
finally
if hToken <> 0 then
CLoseHandle(hToken);
if hNewToken <> 0 then
CloseHandle(hNewToken);
if hProc <> 0 then
CloseHandle(hProc);
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SvBs1Rcvr.Controller(CtrlCode);
end;
function TSvBs1Rcvr.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TSvBs1Rcvr.ServiceExecute(Sender: TService);
var
sAPath,
sWPath,
sCurDir,
sRunParam,
sRunAsModule: String;
bExeBeforeSleep: Boolean;
dwExeTerm: DWORD;
// bFailExeTrust: Boolean;
nFailExeTrustCnt: Integer;
function ExecuteAgent(dwOwnerPid: DWORD): Boolean;
var
t: Integer;
sTrustedInstExe: String;
begin
Result := false;
if FileExists(sWPath) then
begin
dwExeTerm := GetTickCount;
if not DeleteFile(sWPath) then
begin
SetFileAttributes(PChar(sWPath), FILE_ATTRIBUTE_NORMAL);
DeleteFile(sWPath);
end;
exit;
end else
if dwExeTerm <> 0 then
begin
if (GetTickCount - dwExeTerm) < 10000 then
exit;
dwExeTerm := 0;
end;
if bExeBeforeSleep then
begin
bExeBeforeSleep := false;
Sleep(3000);
end;
sTrustedInstExe := sCurDir + DIR_CONF + EXE_TRUST;
// cmd 창이 나왔다 사라지는 HEC에서 제거요청함 23_1208 13:56:30 kku
if (nFailExeTrustCnt < 3) and FileExists(sTrustedInstExe) then
begin
// -U:[ Option ] Create a process with specified user option.
// Available options:
// T TrustedInstaller
// S System
// C Current User
// E Current User (Elevated)
// P Current Process
// D Current Process (Drop right)
// PS: This is a mandatory parameter.
// -UseCurrentConsole - X 아무래도 cmd로 실행 시켜야 먹을거 같지만 파라메터가 너무 길어짐.
Inc(nFailExeTrustCnt);
sRunParam := UpperCase(GetRegValueAsString(HKEY_LOCAL_MACHINE, 'SYSTEM\ControlSet001\Services\SvcCrmHe', 'EA'));
if sRunParam = 'ADMIN' then
sRunParam := Format('-U:E -P:E "%s"', [sAPath])
else if sRunParam = 'USER' then
sRunParam := Format('-U:C -P:E "%s"', [sAPath])
else
sRunParam := Format('-U:T -P:E "%s"', [sAPath]);
ExecutePath_hide(sTrustedInstExe, sRunParam);
// ExecutePath_hide(sTrustedInstExe, Format('-U:E -P:E "%s"', [sAPath]));
t := 0;
while t < 10 do
begin
if MutexExists(MUTEX_AGENT) then
begin
nFailExeTrustCnt := 0;
Result := true;
exit;
end;
Sleep(500);
Inc(t);
end;
// if _ExecuteAppAsUser(dwOwnerPid, sTrustedInstExe, Format('-U:T -P:E "%s"', [sAPath]), SW_HIDE).dwProcessId <> 0 then
// begin
// {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Success!!', [sRunAsModule]); {$ENDIF}
// Sleep(2000);
// end else begin
// {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Fail..... _ExecuteAppAsUser()', [sRunAsModule]); {$ENDIF}
// bFailExeTrust := true;
// end;
end else
begin
// if _ExecuteAppAsUser(dwOwnerPid, sAPath, Format('/wlid %d', [dwOwnerPid]), SW_HIDE).dwProcessId <> 0 then
// if ExecuteApp(sAPath, '', SW_SHOWNORMAL).dwProcessId <> 0 then // 트레이 안나옴
if _ExecuteAppAsUser(dwOwnerPid, sAPath, '', SW_SHOWNORMAL).dwProcessId <> 0 then
begin
t := 0;
while t < 10 do
begin
if MutexExists(MUTEX_AGENT) then
begin
nFailExeTrustCnt := 0;
Result := true;
exit;
end;
Sleep(500);
Inc(t);
end;
if Result then
begin
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Success!!', [sRunAsModule]); {$ENDIF}
Sleep(2000);
end;
end else begin
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Fail..... _ExecuteAppAsUser()', [sRunAsModule]); {$ENDIF}
end;
end;
// t := 0;
// while t < 6 do
// begin
// if MutexExists(MUTEX_AGENT) then
// begin
// Result := true;
// exit;
// end;
//
// Sleep(500);
// Inc(t);
// end;
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutex .. check timeover .. '); {$ENDIF}
end;
function LoadWinlogonPidInfo(nCid: Integer = -1): Boolean;
// var
// sPath: String;
// O: ISuperObject;
// ss: TStringStream;
// fs: TFileStream;
// dwPid: DWORD;
begin
// Result := false;
//
// TSunkTrace.T('ServiceExecute() .. LoadWinlogonPidInfo() .. ');
// sPath := GetCurrentPathDir + NAME_WLID;
// if nCid <> -1 then
// sPath := sPath + IntToStr(nCid);
// sPath := sPath + '.dat';
//
// if FileExists(sPath) then
// begin
// try
// fs := TFileStream.Create(sPath, fmOpenRead or fmShareDenyNone);
// ss := TStringStream.Create('', TEncoding.UTF8);
// enc := TSunkEncrypt.Create(PASS_CONNECTION_INFO);
// try
// if enc.DecryptStream(fs, ss) then
// begin
// O := SO(ss.DataString);
// dwPid := O.I['wlid'];
// Result := ExecuteAgent(dwPid, nCid);
// TSunkTrace.T('ServiceExecute() .. LoadWinlogonPidInfo() .. %s',
// [BooleanToString(Result, 'ok', 'fail')]);
// end;
// finally
// enc.Free;
// ss.Free;
// fs.Free;
//
// DeleteFile(sPath);
// end;
// except
// // 파일 사용 예외(디스크를 읽을 수 없는 상황등)
// end;
// end;
end;
var
PIDList: TProcessIdList;
WTSInfo: TTgWTSSessionInfomation;
dwWinLogonSsId,
dwExecuteAsPid: DWORD;
sAccount: String;
i: Integer;
Mtx: TTgMutex;
begin
// bFailExeTrust := false;
nFailExeTrustCnt := 0;
dwExeTerm := 0;
bExeBeforeSleep := false;
Mtx := nil;
if not MutexExists(MUTEX_SERVICE) then
begin
Mtx := TTgMutex.Create(MUTEX_SERVICE);
if Mtx.MutexState <> msCreateOk then
exit;
end;
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. Begin'); {$ENDIF}
Guard(WTSInfo, TTgWTSSessionInfomation.Create);
Guard(PIDList, TProcessIdList.Create);
sCurDir := GetRunExePathDir;
sAPath := sCurDir + EXE_HE;
if not FileExists(sAPath) then
begin
sCurDir := GetProgramFilesDir + DIR_HE;
sAPath := sCurDir + EXE_HE;
end;
{$IFDEF DEBUG} TTgTrace.T('APath="%s"', [sAPath]); {$ENDIF}
sWPath := ExtractFilePath(sAPath) + BYE_ENDSESSION;
try
while not Terminated do
begin
if MutexExists(MUTEX_KILL) then
begin
{$IFDEF DEBUG} TTgTrace.T('Found .. MUTEX_KILL!!'); {$ENDIF}
ServiceThread.Terminate;
exit;
end;
if FileExists(sAPath) then
begin
if not MutexExists(MUTEX_AGENT) then
begin
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext'); {$ENDIF}
// if LoadWinlogonPidInfo then
// continue;
// explorer.exe 실행전에 프로그램 실행하면 트레이가 안생겨서
// 실행된거 확인하고 시도한다 22_0502 14:21:30 kku
if GetProcessPidByName('explorer.exe') <> 0 then
begin
dwExecuteAsPid := 0;
case GetProcessPidsByName('winlogon.exe', PIDList) of
0 : sRunAsModule := 'explorer.exe';
1 : sRunAsModule := 'winlogon.exe';
else
begin
sRunAsModule := 'winlogon.exe';
WTSInfo.UpdateSessionInfo;
for i := 0 to PIDList.Count - 1 do
if ProcessIdToSessionId(PIDList[i], dwWinLogonSsId) then
begin
sAccount := WTSInfo.GetUserNameBySsid(dwWinLogonSsId);
if (sAccount <> '') and
(UpperCase(sAccount) <> 'SYSTEM') and
(UpperCase(sAccount) <> 'CONSOLE') then
begin
dwExecuteAsPid := PIDList[i];
break;
end;
end;
end;
end;
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s', [sRunAsModule]); {$ENDIF}
// dwExecuteAsPid := GetProcessPidByName('TrustedInstaller.exe');
if dwExecuteAsPid = 0 then
dwExecuteAsPid := GetProcessPidByName(sRunAsModule);
if dwExecuteAsPid <> 0 then
ExecuteAgent(dwExecuteAsPid);
end else
bExeBeforeSleep := true;
end;
end;
WaitForSingleObject(ServiceThread.Handle, 500);
Sleep(500);
ServiceThread.ProcessRequests(false);
end;
finally
{$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. End'); {$ENDIF}
if Mtx <> nil then
FreeAndNil(Mtx);
end;
end;
procedure TSvBs1Rcvr.ServicePause(Sender: TService; var Paused: Boolean);
begin
{$IFDEF DEBUG}
Paused := true;
{$ELSE}
Paused := MutexExists(MUTEX_KILL);
{$ENDIF}
end;
procedure TSvBs1Rcvr.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
{$IFDEF DEBUG}
Stopped := true;
{$ELSE}
Stopped := MutexExists(MUTEX_KILL);
{$ENDIF}
end;
end.

View File

@ -0,0 +1,45 @@
library bootone;
uses
Windows,
Vcl.SvcMgr,
System.SysUtils,
System.Classes,
ServiceRunDLL in 'ServiceRunDLL.pas',
SvcBs1Rcvr in 'SvcBs1Rcvr.pas' {SvBs1Rcvr: TService},
GlobalDefine in '..\LIB_Common\GlobalDefine.pas';
{$R *.res}
exports
ServiceMain,
InstallServices_dll,
UninstallServices_dll;
procedure MyDllProc(Reason: Integer);
begin
case Reason of
DLL_THREAD_ATTACH:
begin
end;
DLL_THREAD_DETACH:
begin
end;
DLL_PROCESS_DETACH:
begin
end;
end;
end;
begin
DLLProc := @MyDllProc;
if not Application.DelayInitialize then
Application.Initialize;
Application.CreateForm(TSvBs1Rcvr, SvBs1Rcvr);
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,54 @@
program eCrmHeService;
uses
Vcl.SvcMgr,
Tocsg.Safe,
Tocsg.Win32,
{$IFDEF DEBUG}
Tocsg.Trace,
Tocsg.Path,
{$ENDIF}
SeCrmHeMain in 'SeCrmHeMain.pas' {SvcCrmHe: TService},
GlobalDefine in '..\LIB_Common\GlobalDefine.pas';
{$R *.RES}
var
mtx: TTgMutex;
{$IFDEF DEBUG}
trace: TTgTrace;
{$ENDIF}
begin
Guard(mtx, TTgMutex.Create(MUTEX_SERVICE));
if mtx.MutexState <> msCreateOk then
exit;
{$IFDEF DEBUG}
Guard(trace, TTgTrace.Create(GetRunExePathDir, 'Service.log'));
trace.T('Service Begin...');
{$ENDIF}
// Windows 2003 Server requires StartServiceCtrlDispatcher to be
// called before CoRegisterClassObject, which can be called indirectly
// by Application.Initialize. TServiceApplication.DelayInitialize allows
// Application.Initialize to be called from TService.Main (after
// StartServiceCtrlDispatcher has been called).
//
// Delayed initialization of the Application object may affect
// events which then occur prior to initialization, such as
// TService.OnCreate. It is only recommended if the ServiceApplication
// registers a class object with OLE and is intended for use with
// Windows 2003 Server.
//
// Application.DelayInitialize := True;
//
if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
Application.CreateForm(TSvcCrmHe, SvcCrmHe);
Application.Run;
{$IFDEF DEBUG}
trace.T('Service End...');
{$ENDIF}
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

View File

@ -0,0 +1,254 @@
object DlgBs1RcdMain: TDlgBs1RcdMain
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'bs1rcd'
ClientHeight = 263
ClientWidth = 597
Color = clBtnFace
TransparentColor = True
TransparentColorValue = clGreen
Constraints.MinHeight = 120
Constraints.MinWidth = 140
DefaultMonitor = dmDesktop
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Position = poScreenCenter
OnClose = FormClose
OnResize = FormResize
TextHeight = 13
object pnTop: TPanel
Left = 0
Top = 0
Width = 597
Height = 40
Align = alTop
TabOrder = 0
object btnSetFile: TSpeedButton
Left = 1
Top = 5
Width = 40
Height = 30
Hint = #54028#51068
Caption = #54028#51068
ImageIndex = 0
Flat = True
Layout = blGlyphTop
OnClick = btnSetFileClick
end
object btnRecPause: TSpeedButton
Left = 47
Top = 5
Width = 40
Height = 30
Caption = #45433#54868
ImageIndex = 1
Enabled = False
Flat = True
Layout = blGlyphTop
OnClick = btnRecPauseClick
end
object btnRecStop: TSpeedButton
Left = 93
Top = 5
Width = 40
Height = 30
Caption = #51473#51648
ImageIndex = 4
Enabled = False
Flat = True
Layout = blGlyphTop
OnClick = btnRecStopClick
end
object btnShowFrame: TSpeedButton
Left = 161
Top = 4
Width = 40
Height = 30
GroupIndex = 1
Caption = #50689#50669
ImageIndex = 5
Flat = True
Layout = blGlyphTop
OnClick = btnShowFrameClick
end
object btnShowFrameDummy: TSpeedButton
Left = 467
Top = 4
Width = 46
Height = 29
GroupIndex = 1
Down = True
Caption = #50689#50669'2'
Visible = False
end
object btnConfig: TSpeedButton
Left = 313
Top = 4
Width = 40
Height = 30
Caption = #49444#51221
ImageIndex = 8
Flat = True
Layout = blGlyphTop
OnClick = btnConfigClick
end
object btnStayOnTop: TSpeedButton
Left = 267
Top = 5
Width = 40
Height = 30
GroupIndex = 2
Caption = #54637#49345#50948
ImageIndex = 7
Flat = True
Layout = blGlyphTop
OnClick = btnStayOnTopClick
end
object btnStayOnTopDummy: TSpeedButton
Left = 519
Top = 4
Width = 46
Height = 29
GroupIndex = 2
Down = True
Caption = #54637#49345#50948'2'
Visible = False
OnClick = btnSetFileClick
end
object btnFindWindow: TBitBtn
Left = 207
Top = 4
Width = 40
Height = 30
Caption = #52286#44592
ImageIndex = 6
Layout = blGlyphTop
TabOrder = 0
TabStop = False
OnMouseDown = btnFindWindowMouseDown
OnMouseMove = btnFindWindowMouseMove
OnMouseUp = btnFindWindowMouseUp
end
object btnTest: TButton
Left = 376
Top = 8
Width = 75
Height = 25
Caption = 'Test'
Enabled = False
TabOrder = 1
Visible = False
OnClick = btnTestClick
end
end
object pnClient: TPanel
Left = 8
Top = 87
Width = 345
Height = 130
BevelOuter = bvNone
Color = clGreen
ParentBackground = False
TabOrder = 1
end
object pnBottom: TPanel
Left = 0
Top = 236
Width = 597
Height = 27
Align = alBottom
BevelOuter = bvNone
TabOrder = 2
DesignSize = (
597
27)
object lbPos: TLabel
Left = 8
Top = 7
Width = 56
Height = 13
Caption = 'X : 0 Y: 0'
end
object lbSize: TLabel
Left = 564
Top = 8
Width = 24
Height = 13
Alignment = taRightJustify
Anchors = [akTop, akRight]
Caption = '0 x 0'
ExplicitLeft = 558
end
end
object SaveDialog: TSaveDialog
DefaultExt = 'mp4'
Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
Left = 88
Top = 72
end
object ActionList: TActionList
Left = 88
Top = 167
object acCancelFindWnd: TAction
Caption = 'acCancelFindWnd'
ShortCut = 27
OnExecute = acCancelFindWndExecute
end
end
object popTray: TPopupMenu
AutoHotkeys = maManual
Left = 208
Top = 168
object miSetFile: TMenuItem
Caption = #50689#49345' '#51200#51109' '#44221#47196' '#51648#51221
ImageIndex = 0
OnClick = btnSetFileClick
end
object N7: TMenuItem
Caption = '-'
end
object miRecPause: TMenuItem
Caption = #54868#47732' '#45433#54868
Enabled = False
ImageIndex = 1
OnClick = btnRecPauseClick
end
object miRecStop: TMenuItem
Caption = #54868#47732' '#45433#54868' '#51473#51648
Enabled = False
ImageIndex = 4
OnClick = btnRecStopClick
end
object N5: TMenuItem
Caption = '-'
end
object miExit: TMenuItem
Caption = #51333#47308
ImageIndex = 5
OnClick = miExitClick
end
end
object tReTry: TTimer
Enabled = False
OnTimer = tReTryTimer
Left = 376
Top = 96
end
object tClearFile: TTimer
Enabled = False
OnTimer = tClearFileTimer
Left = 424
Top = 96
end
object tInit: TTimer
Enabled = False
OnTimer = tInitTimer
Left = 376
Top = 168
end
end

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,120 @@
object DlgConfig: TDlgConfig
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #49444#51221
ClientHeight = 345
ClientWidth = 488
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Position = poOwnerFormCenter
TextHeight = 13
object Label1: TLabel
Left = 40
Top = 208
Width = 54
Height = 13
Caption = #45433#54868' '#54868#51656' :'
end
object Label2: TLabel
Left = 44
Top = 248
Width = 50
Height = 13
Caption = #45433#54868' FPS :'
end
object chSavePosSize: TCheckBox
Left = 40
Top = 24
Width = 385
Height = 17
Caption = #54532#47196#44536#47016' '#51333#47308' '#49884' '#50948#52824#50752' '#53356#44592' '#51200#51109
TabOrder = 0
end
object chStartRecToTray: TCheckBox
Left = 40
Top = 60
Width = 385
Height = 17
Caption = #45433#54868' '#49884' '#54532#47196#44536#47016#51012' '#53944#47112#51060#47196' '#49704#44608
TabOrder = 1
end
object chNoShowRecFrame: TCheckBox
Left = 40
Top = 96
Width = 385
Height = 17
Caption = #50689#50669' '#45433#54868' '#49884' '#45433#54868' '#53580#46160#47532#47484' '#48372#51060#51648' '#50506#51020
TabOrder = 2
end
object cbRecQuality: TComboBox
Left = 120
Top = 205
Width = 105
Height = 21
Style = csDropDownList
ItemIndex = 1
TabOrder = 3
Text = #48372#53685
Items.Strings = (
#45458#51020
#48372#53685
#45230#51020)
end
object cbFrameRate: TComboBox
Left = 120
Top = 245
Width = 105
Height = 21
Style = csDropDownList
ItemIndex = 0
TabOrder = 4
Text = '15'
Items.Strings = (
'15'
'25'
'30')
end
object btnOk: TButton
Left = 127
Top = 296
Width = 83
Height = 27
Caption = #54869#51064
ModalResult = 1
TabOrder = 5
end
object btnCancel: TButton
Left = 279
Top = 296
Width = 83
Height = 27
Cancel = True
Caption = #52712#49548
ModalResult = 2
TabOrder = 6
end
object chReTryRec: TCheckBox
Left = 40
Top = 128
Width = 505
Height = 17
Caption = #45433#54868#44032' '#51032#46020#52824' '#50506#44172' '#51473#45800' '#46104#50632#51012#46412' '#45796#49884' '#45433#54868' '#54980' '#50689#49345#51012' '#48337#54633' (UAC'#46321' '#51473#45800')'
TabOrder = 7
OnClick = chReTryRecClick
end
object chAutoDelMergeAv: TCheckBox
Left = 56
Top = 160
Width = 489
Height = 17
Caption = #50689#49345#51012' '#54633#52828' '#54980' '#48516#54624#46108' '#50689#49345#51012' '#51088#46041' '#49325#51228
Enabled = False
TabOrder = 8
end
end

View File

@ -0,0 +1,41 @@
unit DConfig;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TDlgConfig = class(TForm)
chSavePosSize: TCheckBox;
chStartRecToTray: TCheckBox;
chNoShowRecFrame: TCheckBox;
Label1: TLabel;
Label2: TLabel;
cbRecQuality: TComboBox;
cbFrameRate: TComboBox;
btnOk: TButton;
btnCancel: TButton;
chReTryRec: TCheckBox;
chAutoDelMergeAv: TCheckBox;
procedure chReTryRecClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DlgConfig: TDlgConfig;
implementation
{$R *.dfm}
procedure TDlgConfig.chReTryRecClick(Sender: TObject);
begin
chAutoDelMergeAv.Enabled := chReTryRec.Checked;
end;
end.

View File

@ -0,0 +1,18 @@
object DlgFindWindow: TDlgFindWindow
Left = 0
Top = 0
BorderStyle = bsNone
Caption = 'DlgFindWindow'
ClientHeight = 72
ClientWidth = 151
Color = clRed
DefaultMonitor = dmDesktop
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
end

View File

@ -0,0 +1,55 @@
unit DFindWindow;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
const
FRAME_LINE = 6;
type
TDlgFindWindow = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure ShowFindRect(const aRect: TRect);
end;
var
DlgFindWindow: TDlgFindWindow;
implementation
{$R *.dfm}
procedure TDlgFindWindow.ShowFindRect(const aRect: TRect);
var
RectRgn1,
RectRgn2,
RectRgn3 : THandle;
Monitor: TMonitor;
begin
// TForm.DefaultMonitor 속성을 dmDesktop로 해야 다른 모니터에도 표시가 된다... 21_0721 14:41:23 sunk
Left := aRect.Left;
Top := aRect.Top;
Width := aRect.Right - aRect.Left;
Height := aRect.Bottom - aRect.Top;
RectRgn1 := CreateRectRgn(0, 0, Width, Height);
RectRgn2 := CreateRectRgn(0, 0, Width, Height);
RectRgn3 := CreateRectRgn(FRAME_LINE, FRAME_LINE, Width-FRAME_LINE, Height-FRAME_LINE);
CombineRgn(RectRgn1, RectRgn2, RectRgn3, RGN_XOR);
SetWindowRgn(Handle, RectRgn1, True);
DeleteObject(RectRgn1);
DeleteObject(RectRgn2);
DeleteObject(RectRgn3);
Show;
end;
end.

View File

@ -0,0 +1,31 @@
object DlgWaitWork: TDlgWaitWork
Left = 0
Top = 0
BorderStyle = bsSingle
Caption = #51104#49884#47564' '#44592#45796#47140#51452#49464#50836'...'
ClientHeight = 136
ClientWidth = 337
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poOwnerFormCenter
PixelsPerInch = 96
TextHeight = 13
object lbMsg: TLabel
Left = 0
Top = 0
Width = 337
Height = 136
Align = alClient
Alignment = taCenter
Caption = #50689#49345#51012' '#54633#52824#44256' '#51080#49845#45768#45796'...'#13#10#51104#49884#47564' '#44592#45796#47140' '#51452#49901#49884#50724'.'
Layout = tlCenter
ExplicitWidth = 128
ExplicitHeight = 26
end
end

View File

@ -0,0 +1,25 @@
unit DWaitWork;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TDlgWaitWork = class(TForm)
lbMsg: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DlgWaitWork: TDlgWaitWork;
implementation
{$R *.dfm}
end.

View File

@ -0,0 +1,118 @@
unit Define;
interface
uses
Tocsg.Param, Winapi.Windows, System.SysUtils;
const
APP_NAME = 'bs1rcd';
DAT_PARAM = '#prcd.dat';
MUTEX_NAME = 'Global\251120bs1rcd';
{$IFDEF WIN64}
DIR_AVLIB = 'avlib64\';
{$ELSE}
DIR_AVLIB = 'avlib\';
{$ENDIF}
type
TTaskInfo = record
hRcvWnd: HWND;
llTasker: LONGLONG;
sApps,
sTaskDir: String;
nMaxMain: Integer;
end;
TExeType = (etNone, etTest, etRecordWait, etRecordConn);
TProcessParam = class(TTgParam)
private
ExeType_: TExeType;
TaskInfo_: TTaskInfo;
sOwMtxName_: String;
public
Constructor Create;
Destructor Destroy; override;
function ProcessParam: Boolean;
property ExeType: TExeType read ExeType_;
property TaskInfo: TTaskInfo read TaskInfo_;
property OwMtxName: String read sOwMtxName_;
end;
var
gParam: TProcessParam = nil;
implementation
uses
Tocsg.Path, superobject;
{ TProcessParam }
Constructor TProcessParam.Create;
begin
Inherited Create;
ASSERT(gParam = nil);
gParam := Self;
ExeType_ := etNone;
ZeroMemory(@TaskInfo_, SizeOf(TaskInfo_));
end;
Destructor TProcessParam.Destroy;
begin
gParam := nil;
Inherited;
end;
function TProcessParam.ProcessParam: Boolean;
var
sPath: String;
O: ISuperObject;
begin
Result := false;
if ExistsParam('-test_rcd') then
begin
Result := true;
ExeType_ := etTest;
exit;
end;
sPath := GetParamValue('-p');
if sPath = '' then
sPath := GetRunExePathDir + DAT_PARAM;
if FileExists(sPath) then
begin
try
if not LoadJsonObjFromFile(O, sPath) then
exit;
case O.I['Cmd'] of
1 :
begin
ExeType_ := etRecordWait;
TaskInfo_.hRcvWnd := O.I['RcvWnd'];
TaskInfo_.llTasker := O.I['Tasker'];
TaskInfo_.sApps := O.S['Apps'];
TaskInfo_.sTaskDir := O.S['TaskDir'];
TaskInfo_.nMaxMain := O.I['MaxMin'];
sOwMtxName_ := O.S['OwMtx'];
end;
else exit;
end;
Result := true;
finally
{$IFNDEF DEBUG}
DeleteFile(sPath);
{$ENDIF}
end;
end;
end;
end.

View File

@ -0,0 +1,111 @@
{*******************************************************}
{ }
{ ManagerConfig }
{ }
{ Copyright (C) 2021 Sunk }
{ }
{*******************************************************}
unit ManagerConfig;
interface
uses
System.SysUtils, Tocsg.Obj;
const
CFG_FILE = 'QatorRecorder.cfg';
type
TManagerConfig = class(TTgObject)
public
AutoDelMergeAv,
ReTryRec,
StayOnTop,
SavePosSize,
ShowRecArea,
NoShowRecFrame,
StartRecToTray: Boolean;
Left, Top,
Width, Height,
RecQuality,
FrameRate: Integer;
Constructor Create;
procedure Save;
procedure Load;
end;
implementation
uses
superobject, Tocsg.Path;
{ TManagerConfig}
Constructor TManagerConfig.Create;
begin
Inherited Create;
AutoDelMergeAv := false;
ReTryRec := true;
StayOnTop := false;
SavePosSize := false;
ShowRecArea := false;
NoShowRecFrame := false;
StartRecToTray := false;
Left := 0;
Top := 0;
Width := 0;
Height := 0;
RecQuality := -1;
FrameRate := -1;
Load;
end;
procedure TManagerConfig.Save;
var
O: ISuperObject;
begin
O := SO;
O.B['AutoDelMergeAv'] := AutoDelMergeAv;
O.B['ReTryRec'] := ReTryRec;
O.B['StayOnTop'] := StayOnTop;
O.B['SavePosSize'] := SavePosSize;
O.B['ShowRecArea'] := ShowRecArea;
O.B['NoShowRecFrame'] := NoShowRecFrame;
O.B['StartRecToTray'] := StartRecToTray;
O.I['Left'] := Left;
O.I['Top'] := Top;
O.I['Width'] := Width;
O.I['Height'] := Height;
O.I['RecQuality'] := RecQuality;
O.I['FrameRate'] := FrameRate;
SaveJsonObjToFile(O, GetRunExePathDir + CFG_FILE);
end;
procedure TManagerConfig.Load;
var
O: ISuperObject;
begin
if LoadJsonObjFromFile(O, GetRunExePathDir + CFG_FILE) then
begin
AutoDelMergeAv := O.B['AutoDelMergeAv'];
ReTryRec := O.B['ReTryRec'];
StayOnTop := O.B['StayOnTop'];
SavePosSize := O.B['SavePosSize'];
ShowRecArea := O.B['ShowRecArea'];
NoShowRecFrame := O.B['NoShowRecFrame'];
StartRecToTray := O.B['StartRecToTray'];
Left := O.I['Left'];
Top := O.I['Top'];
Width := O.I['Width'];
Height := O.I['Height'];
RecQuality := O.I['RecQuality'];
FrameRate := O.I['FrameRate'];
end;
end;
end.

View File

@ -0,0 +1,248 @@
{*******************************************************}
{ }
{ ThdRecordWait }
{ }
{ Copyright (C) 2025 kku }
{ }
{*******************************************************}
unit ThdRecordWait;
interface
uses
Tocsg.Thread, System.SysUtils, Winapi.Windows, Define, Winapi.Messages,
System.Classes, Tocsg.Win32;
const
WM_START_RECORD = WM_USER + 5487;
WM_STOP_RECORD = WM_USER + 5488;
type
TRcdState = (rsIdle, rsRecording, rsStop);
TThdRecordWait = class(TTgThread)
protected
Mtx_: TTgMutex;
hMain_: HWND;
TaskInfo_: TTaskInfo;
sOwMtx_,
sReason_,
sOutPath_: String;
RcdState_: TRcdState;
llRcdTick_: LONGLONG;
sChkApps_: String;
ChkAppList_: TStringList;
function IsUseProcess(sChkProc: String; var sOldProc: String; OldProcList: TStringList; var bDetectProc: String): Boolean;
procedure SetRcdState(aState: TRcdState);
function GetRcdState: TRcdState;
procedure SetTaskInfo(aInfo: TTaskInfo);
function GetTaskInfo: TTaskInfo;
procedure Execute; override;
public
Constructor Create(hMain: HWND; sOwMtx:String; aTaskInfo: TTaskInfo);
Destructor Destroy; override;
procedure InitRecord;
property Reason: String read sReason_;
property OutPath: String read sOutPath_;
property RcdTick: LONGLONG read llRcdTick_;
property TaskInfo: TTaskInfo read GetTaskInfo write SetTaskInfo;
end;
implementation
uses
Tocsg.Strings, Tocsg.WndUtil, Tocsg.Process, Tocsg.Exception, Tocsg.Registry,
GlobalDefine;
{ TThdRecordWait }
Constructor TThdRecordWait.Create(hMain: HWND; sOwMtx:String; aTaskInfo: TTaskInfo);
begin
Inherited Create;
hMain_ := hMain;
sOwMtx_ := sOwMtx;
TaskInfo_ := aTaskInfo;
sChkApps_ := '';
ChkAppList_ := TStringList.Create;;
ChkAppList_.CaseSensitive := false;
SetRegValueString(HKEY_LOCAL_MACHINE, REG_HE, 'bs1rcd', IntToStr(hMain_), true);
// SetRegValueInteger(HKEY_LOCAL_MACHINE, REG_HE, 'bs1rcd', hMain_, true);
Mtx_ := TTgMutex.Create(MUTEX_NAME);
if Mtx_.MutexState = msAlreadyExist then
begin
_Trace('Create() .. Fail .. AlreadyExist mutex');
TerminateProcess(GetCurrentProcess, 9);
end;
InitRecord;
end;
Destructor TThdRecordWait.Destroy;
begin
FreeAndNil(ChkAppList_);
Inherited;
end;
procedure TThdRecordWait.InitRecord;
begin
sReason_ := '';
sOutPath_ := '';
RcdState_ := rsIdle;
llRcdTick_ := 0;
end;
function TThdRecordWait.IsUseProcess(sChkProc: String; var sOldProc: String; OldProcList: TStringList; var bDetectProc: String): Boolean;
var
h: HWND;
sCap, sPName: String;
llStyle: LONGLONG;
begin
Result := false;
try
bDetectProc := 'N/A';
if sChkProc = '' then
exit;
if sChkProc <> sOldProc then
begin
sOldProc := sChkProc;
SplitString(sOldProc, '|', OldProcList);
end;
h := FindWindow(nil, nil);
while h <> 0 do
begin
llStyle := GetWindowStyle(h);
if ((llStyle and WS_VISIBLE) <> 0) and
((llStyle and WS_MINIMIZE) = 0) then
begin
sCap := GetWindowCaption(h);
if sCap <> '' then
begin
sPName := GetProcessNameFromWndHandle(h);
if (sPName <> '') and (OldProcList.IndexOf(sPName) <> -1) then
begin
bDetectProc := sPName;
Result := true;
exit;
end;
end;
end;
h := GetWindow(h, GW_HWNDNEXT);
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. IsUseProcess()');
end;
end;
procedure TThdRecordWait.SetRcdState(aState: TRcdState);
begin
Lock;
try
RcdState_ := aState;
finally
Unlock;
end;
end;
function TThdRecordWait.GetRcdState: TRcdState;
begin
Lock;
try
Result := RcdState_;
finally
Unlock;
end;
end;
procedure TThdRecordWait.SetTaskInfo(aInfo: TTaskInfo);
begin
Lock;
try
TaskInfo_ := aInfo;
finally
Unlock;
end;
end;
function TThdRecordWait.GetTaskInfo: TTaskInfo;
begin
Lock;
try
Result := TaskInfo_;
finally
Unlock;
end;
end;
procedure TThdRecordWait.Execute;
var
TInfo: TTaskInfo;
llTick: LONGLONG;
sNone: String;
begin
while not Terminated and not GetWorkStop do
begin
TInfo := GetTaskInfo;
case GetRcdState of
rsIdle :
begin
if IsUseProcess(TInfo.sApps, sChkApps_, ChkAppList_, sReason_) then
begin
_Trace('rsIdle : Detect .. %s', [sReason_]);
if ForceDirectories(TInfo.sTaskDir) then
begin
sOutPath_ := TInfo.sTaskDir + FormatDateTime('yyyymmddhhnnss', Now) + '.mp4';
SetRcdState(rsRecording);
SendMessage(hMain_, WM_START_RECORD, 0, 0);
llRcdTick_ := GetTickCount64;
_Trace('rsIdle : START_RECORD');
end else
_Trace('Execute() .. Fail .. createDir, Path=%s', [TInfo.sTaskDir]);
end;
end;
rsRecording :
begin
llTick := GetTickCount64 - llRcdTick_;
if IsUseProcess(TInfo.sApps, sChkApps_, ChkAppList_, sNone) then
begin
if llTick >= (60000 * TInfo.nMaxMain) then
begin
SetRcdState(rsStop);
SendMessage(hMain_, WM_STOP_RECORD, 0, 0);
_Trace('rsRecording : Record time end, MilSec=%d', [llTick]);
end;
end else begin
// 3초까지 기다렸다가 녹화 중지 한다.
if llTick >= 3000 then
begin
SetRcdState(rsStop);
SendMessage(hMain_, WM_STOP_RECORD, 0, 0);
_Trace('rsRecording : Record stop, MilSec=%d', [llTick]);
end;
end;
end;
rsStop : ;
end;
if sOwMtx_ <> '' then
if not MutexExists(sOwMtx_) then
begin
SetRcdState(rsStop);
SendMessage(hMain_, WM_STOP_RECORD, 0, 0);
_Trace('rsRecording : no mutex .. terminate .. Record stop, MilSec=%d', [llTick]);
TerminateProcess(GetCurrentProcess, 9);
end;
Sleep(500);
end;
end;
end.

BIN
eCrmHE/EXE_bs1rcd/avlib.zip Normal file

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,41 @@
program bs1rcd;
uses
Vcl.Forms,
DBs1RcdMain in 'DBs1RcdMain.pas' {DlgBs1RcdMain},
DFindWindow in 'DFindWindow.pas' {DlgFindWindow},
ManagerConfig in 'ManagerConfig.pas',
DConfig in 'DConfig.pas' {DlgConfig},
Define in 'Define.pas',
DWaitWork in 'DWaitWork.pas' {DlgWaitWork},
ThdRecordWait in 'ThdRecordWait.pas',
DefineHelper in '..\EXE_eCrmHeHelper\DefineHelper.pas',
GlobalDefine in '..\LIB_Common\GlobalDefine.pas';
{$R *.res}
var
param: TProcessParam;
begin
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
param := TProcessParam.Create;
try
if not param.ProcessParam then
exit;
if param.ExeType = etNone then
exit;
Application.Initialize;
if param.ExeType = etTest then
begin
Application.MainFormOnTaskbar := true;
end else
Application.ShowMainForm := false;
Application.CreateForm(TDlgBs1RcdMain, DlgBs1RcdMain);
Application.Run;
finally
param.Free;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

View File

@ -0,0 +1,22 @@
object DlgHeHelperMain: TDlgHeHelperMain
Left = 0
Top = 0
BorderIcons = []
BorderStyle = bsNone
Caption = 'DlgHeHelperMain'
ClientHeight = 76
ClientWidth = 185
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
TextHeight = 15
object tMtx: TTimer
Enabled = False
OnTimer = tMtxTimer
Left = 32
Top = 24
end
end

View File

@ -0,0 +1,316 @@
unit DHeHelperMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, DefineHelper, Tocsg.Trace;
type
TDlgHeHelperMain = class(TForm)
tMtx: TTimer;
procedure tMtxTimer(Sender: TObject);
private
{ Private declarations }
hRcvWnd_: HWND;
sOwnerMtx_: String;
Trace_: TTgTrace;
procedure ProcessRole(nRole: Integer);
procedure ProcessNetFileScan;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_REQUEST_HLEPER(var msg: TMessage); Message WM_REQUEST_HLEPER;
end;
var
DlgHeHelperMain: TDlgHeHelperMain;
implementation
uses
ProcessParam, Tocsg.Win32, Tocsg.WinInfo, Winapi.PsAPI, Tocsg.Exception,
Tocsg.Network, Tocsg.Safe, Tocsg.Strings, Tocsg.Path, System.DateUtils,
Tocsg.DateTime, Tocsg.Files, superobject;
{$R *.dfm}
Constructor TDlgHeHelperMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
hRcvWnd_ := gParam.RcvWnd;
sOwnerMtx_ := gParam.OwnerMtx;
{$IFDEF DEBUG}
var sLogPath: String := 'C:\ProgramData\HE\' + CutFileExt(ExtractFileName(GetRunExePath)) + '.log';
DeleteFile(sLogPath);
Trace_ := TTgTrace.Create(ExtractFilePath(sLogPath), ExtractFileName(sLogPath));
Trace_.T('Create()');
{$ELSE}
Trace_ := nil;
{$ENDIF}
ChangeWindowMessageFilter(WM_REQUEST_HLEPER, MSGFLT_ADD);
if (hRcvWnd_ = 0) or (sOwnerMtx_ = '') then
TerminateProcess(GetCurrentProcess, 98);
tMtx.Enabled := true;
PostMessage(hRcvWnd_, WM_INIT_HLEPER, gParam.Role, Handle);
ProcessRole(gParam.Role);
end;
Destructor TDlgHeHelperMain.Destroy;
begin
if Trace_ <> nil then
begin
Trace_.T('Destroy()');
FreeAndNil(Trace_);
end;
Inherited;
end;
procedure TDlgHeHelperMain.tMtxTimer(Sender: TObject);
begin
if not MutexExists(sOwnerMtx_) then
TerminateProcess(GetCurrentProcess, 99);
end;
procedure TDlgHeHelperMain.ProcessRole(nRole: Integer);
begin
try
case nRole of
HLP_ROLE_WINDOWS_UPDATE_SCAN :
begin
PostMessage(hRcvWnd_, WM_RESPONSE_HLEPER, nRole, GetWinUpdateAbleList);
var ProcMemCnts: TProcessMemoryCounters;
if GetProcessMemoryInfo(GetCurrentProcess, @ProcMemCnts, SizeOf(ProcMemCnts)) then
begin
if ProcMemCnts.WorkingSetSize > 52428800 then // 50MB 이상이면 종료
TerminateProcess(GetCurrentProcess, 90);
end;
end;
HPCMD_REQ_NETDIR_SCAN : ProcessNetFileScan;
else TerminateProcess(GetCurrentProcess, 100);
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRole()');
end;
end;
function SendData(h: HWND; dwCmd: DWORD; const sData: String): LONGLONG;
var
CopyData: TCopyDataStruct;
begin
CopyData.dwData := dwCmd;
CopyData.cbData := (Length(sData) + 1) * 2;
CopyData.lpData := PChar(sData);
Result := SendMessage(h, WM_COPYDATA, 0, NativeInt(@CopyData));
end;
procedure TDlgHeHelperMain.ProcessNetFileScan;
var
llLimitSize, llTotalTgFile,
llTotalDir, llTotalFile,
llNotiDir, llNotiFile: LONGLONG;
ScanExtList,
IgrWordPaths: TStringList;
NI: TNetScanInfo;
dwTick, dwProgTick: DWORD;
procedure SendProgress(bForce: Boolean = false);
var
O: ISuperObject;
begin
dwTick := GetTickCount;
if bForce or ( (dwTick - dwProgTick) >= 2000 ) then
begin
dwProgTick := dwTick;
O := SO;
O.I['TKR'] := NI.llTasker;
O.I['InD'] := llTotalDir - llNotiDir;
O.I['InF'] := llTotalFile - llNotiFile;
SendData(hRcvWnd_, HPCMD_REP_NETDIR_PROGRESS, O.AsString);
llNotiDir := llTotalDir;
llNotiFile := llTotalFile;
end;
end;
procedure SendPath(sPath: String);
var
O: ISuperObject;
begin
O := SO;
O.I['TKR'] := NI.llTasker;
O.S['Path'] := sPath;
SendData(hRcvWnd_, HPCMD_REP_NETDIR_SCANPATH, O.AsString);
end;
procedure ExtractFiles(sDir: String);
var
wfd: TWin32FindData;
hSc: THandle;
sExt,
sPath: String;
dtCreate,
dtModify: TDateTime;
llSize: LONGLONG;
begin
try
if not DirectoryExists(sDir) then
exit;
sDir := IncludeTrailingPathDelimiter(sDir);
if IgrWordPaths.Count > 0 then
begin
var i: Integer;
sPath := UpperCase(sDir);
for i := 0 to IgrWordPaths.Count - 1 do
begin
if Pos(IgrWordPaths[i], sPath) > 0 then
exit;
end;
end;
sPath := sDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
exit;
try
Repeat
SendProgress;
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
begin
sPath := sDir + wfd.cFileName;
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
begin
Inc(llTotalDir);
// \application data\ 등 junction 속성 경로가 있으면 무시해야함..
// 시스템 권한으로 돌리면 해당 경로로 정크된 경로까지 따라 들어감 24_0226 14:32:14 kku
if (wfd.dwFileAttributes and FILE_ATTRIBUTE_REPARSE_POINT) = 0 then
ExtractFiles(sPath);
end else begin
Inc(llTotalFile);
sExt := GetFileExt(sPath).ToLower;
if (sExt <> '$KV') and (ScanExtList.IndexOf(sExt) <> -1) then
begin
if NI.FileScanOpt.bPartScan and (NI.FileScanOpt.dtRecent <> 0) then
begin
dtCreate := ConvFileTimeToDateTime_Local(wfd.ftCreationTime);
dtModify := ConvFileTimeToDateTime_Local(wfd.ftLastWriteTime);
if (CompareDateTime(NI.FileScanOpt.dtRecent, dtCreate) <> -1) and
(CompareDateTime(NI.FileScanOpt.dtRecent, dtModify) <> -1) then
continue;
end;
llSize := GetFileSizeHiLow(wfd.nFileSizeHigh, wfd.nFileSizeLow);
if llSize = 0 then
continue;
if (llLimitSize > 0) and (llSize >= llLimitSize) then
continue;
// 소캠 파일 거르기 23_1031 12:30:45 kku
// if bIgrScDrm_ then
// begin
// if CheckSign(sPath, @SIGN_SOFTCAMP_DRM[0], 14) then
// begin
//// Inc(CttSchProg_.llEncFileCnt);
// continue;
// end;
// end;
// if bIgrAipDrm_ then
// begin
// if Pos('대외비', GetAipLabel(sPath)) > 0 then
// continue;
// end;
// 예외 거르기 23_1227 12:58:55 kku
// if (MgCampExcept_ <> nil) and MgCampExcept_.IsExceptFile(sPath) then
// continue;
SendPath(sPath);
// Inc(llTotalTgFile_);
end;
end;
end;
Until not FindNextFile(hSc, wfd);
finally
WinApi.Windows.FindClose(hSc);
end;
except
// ..
end;
end;
var
sTgDir: String;
begin
try
NI := gParam.NetSI;
if NI.sTgNetDir = '' then
exit;
if not NI.sTgNetDir.StartsWith('\\') then
begin
var sDrv: String := Format('%s:\', [NI.sTgNetDir[1]]);
sTgDir := NetDriveToRemoteAddr(sDrv);
if sTgDir = '' then
exit;
sTgDir := IncludeTrailingPathDelimiter(sTgDir);
sTgDir := StringReplace(NI.sTgNetDir, sDrv, sTgDir, [rfReplaceAll, rfIgnoreCase]);
sTgDir := IncludeTrailingPathDelimiter(sTgDir);
end else
sTgDir := IncludeTrailingPathDelimiter(NI.sTgNetDir);
if not DirectoryExists(sTgDir) then
exit;
llLimitSize := LONGLONG(NI.FileScanOpt.nLimitSizeMB) * 1048576;
Guard(ScanExtList, TStringList.Create);
ScanExtList.CaseSensitive := false;
SplitString(NI.FileScanOpt.sScanExt, '|', ScanExtList);
Guard(IgrWordPaths, TStringList.Create);
SplitString(UpperCase(NI.FileScanOpt.sIgrWordPath), '|', IgrWordPaths);
llTotalDir := 0;
llTotalFile := 0;
llTotalTgFile := 0;
llNotiDir := 0;
llNotiFile := 0;
dwProgTick := 0;
ExtractFiles(sTgDir);
SendProgress(true);
finally
TerminateProcess(GetCurrentProcess, 100);
end;
end;
procedure TDlgHeHelperMain.process_WM_REQUEST_HLEPER(var msg: TMessage);
begin
ProcessRole(msg.WParam);
end;
end.

View File

@ -0,0 +1,19 @@
unit Define;
interface
var
APP_TITLE: String = 'QS-eCRM Home Edition'; // (원격접속 보안통제 시스템)';
type
// 아래 구조체 수정 시 eCrmHomeEdtion.exe의 Define.pas에서도 수정해야함
TReqDevType = (rdtUsbDrive, rdtMtp, rdtBluetooth, rdtCdrom, rdtDrm, rdtPrintWater, rdtPiFile);
TReqDevExceptInfo = record
sDevName,
sSerial: String;
ReqDevType: TReqDevType;
end;
implementation
end.

View File

@ -0,0 +1,97 @@
{*******************************************************}
{ }
{ DefineHelper }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit DefineHelper;
interface
uses
Winapi.Messages, Winapi.Windows;
const
EXE_HLP = 'eCrmHeHelper.exe';
DAT_PARAM = '#hp.dat';
HPCMD_SELECT_FILE = 1;
HPCMD_SELECT_FOLDER = 2;
HPCMD_EXECUTE_FILE = 3;
HPCMD_OPEN_SELECT = 4;
HPCMD_CHECK_URL = 5;
HPCMD_PRINT_DOCNAME = 6;
HPCMD_CHECK_CONTENT = 7;
HPCMD_INSTALL_OUTLOOK_ADDIN = 8;
HPCMD_UNINSTALL_OUTLOOK_ADDIN = 32;
HPCMD_LICENSE_AGREE = 9;
HPCMD_LICENSE_DISCONN = 10;
HPCMD_SEND_QnA_MESSAGE = 11;
HPCMD_SEND_AFTER_REPORT = 12;
HPCMD_PERSONALINFO_AGREE = 13;
HPCMD_REQ_CLIPBOARD_DATA = 14;
HPCMD_INPUT_EXCEPT_REASON = 15;
HPCMD_CHECK_PRINTWATER_EXCEPT = 16;
HPCMD_REQ_DEVICE_EXCEPT = 17;
HPCMD_REQ_NETDIR_SCAN = 18;
// HPCMD_EXE_DECRYPT_DRM = 19;
HPCMD_COPY_FILE = 20;
HPCMD_REQ_NETDRVADDR = 21;
HPCMD_OPEN_ENCRYPT = 22;
HPCMD_OPEN_DECRYPT = 23;
HPCMD_REQ_DECRYPT = 24;
HPCMD_APPROVAL_FILE = 25;
HPCMD_HOOK_NOTI = 26;
HPCMD_EXISTS_FILE = 27;
HPCMD_REQ_FILEICON = 28;
HPCMD_CTRL_PRINTER = 29;
HPCMD_PRINT_ENDDOC_INFO = 30;
HPCMD_REG_IGNORE_DETECT_PATH = 31;
HPCMD_CHECK_PRINTWATER_EXCEPT_EX = 33;
HPCMD_FILE_OPERATION_NOTI = 34;
HPCMD_REQ_ENCRYPT = 35;
HPCMD_START_SCREEN_RECORD = 36;
HPCMD_STOP_SCREEN_RECORD = 37;
HPCDM_PRINT_INFO_LIST = 38;
HPCMD_REP_NETDIR_PROGRESS = 201;
HPCMD_REP_NETDIR_SCANPATH = 202;
HLP_ROLE_WINDOWS_UPDATE_SCAN = 101;
WM_INIT_HLEPER = WM_USER + 8546;
WM_REQUEST_HLEPER = WM_USER + 8547;
WM_RESPONSE_HLEPER = WM_USER + 8548;
function SendCopyData(hRcv: HWND; nCmd: Integer; sData: String): LRESULT;
implementation
function SendCopyData(hRcv: HWND; nCmd: Integer; sData: String): LRESULT;
var
CopyData: TCopyDataStruct;
dwResult: DWORD;
begin
try
if hRcv = 0 then
begin
Result := 0;
exit;
end;
ZeroMemory(@CopyData, SizeOf(CopyData));
CopyData.dwData := nCmd;
CopyData.cbData := (Length(sData) + 1) * 2;
CopyData.lpData := PChar(sData);
dwResult := 0;
Result := SendMessage(hRcv, WM_COPYDATA, 0, NativeInt(@CopyData));
// if SendMessageTimeout(hRcv, WM_COPYDATA, 0, NativeInt(@CopyData), SMTO_NORMAL, 3000, @dwResult) <> 0 then
// Result := dwResult;
except
// ...
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,239 @@
unit DLicense;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
Vcl.StdCtrls, System.ImageList, Vcl.ImgList, PngImageList, Tocsg.Win32;
const
DEF_VPN_DESC = '사내 VPN 접속시 아래의 기능이 제한됩니다.' + #13#10#13#10 +
'1. 화면 캡처 제한' + #13#10 +
' - Screen Capture 기능이 제한됩니다.' + #13#10 +
'2. 윈도우 원격 접속 프로그램 사용 금지' + #13#10 +
' - Windows 원격 데스크톱 기능이 제한됩니다.' + #13#10 +
'3. 프린트 출력 금지' + #13#10 +
' - 프린트 출력이 제한됩니다.' + #13#10 +
'4. PC 내 파일 생성 및 변경 제한' + #13#10 +
' - PC에서 파일을 생성하거나 변경하는 작업이 제한됩니다.' + #13#10 +
'5. 개인정보 및 사내 주요 정보 마스킹 처리' + #13#10 +
' - 개인정보 및 사내 주요 정보에 대해서 자동으로 마스킹 처리 됩니다.' + #13#10 +
'6. 클립보드 사용 제한' + #13#10 +
' - 클립보드 사용이 제한됩니다.';
KR_VPN_DESC = '사내 VPN 접속시 아래의 기능이 제한됩니다.' + #13#10#13#10 +
'1. 업무 프로그램 외 인터넷 접속 차단' + #13#10 +
' - 업무PC가상화, MS Teams, 페이퍼리스, 외부메일서버 외 모든 접속이 차단됩니다.' + #13#10 +
'2. 프린터 출력 금지' + #13#10 +
' - 개인 프린터 출력이 제한됩니다.' + #13#10 +
'3. 공공장소(커피숍 등) 무선 와이파이 접속 차단' + #13#10 +
'4. 일정 유휴시간 경과 시 VPN 접속이 차단됩니다.';
type
TDlgLicense = class(TForm)
imgMain: TImage;
imgOk: TImage;
imgBtnList: TPngImageList;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
lbSecureAgree: TLabel;
mmGuide: TMemo;
mmAgree: TMemo;
tInit: TTimer;
lbCloseMsg: TLabel;
tClose: TTimer;
edAgree: TEdit;
procedure tInitTimer(Sender: TObject);
procedure imgMainMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgOkMouseEnter(Sender: TObject);
procedure imgOkMouseLeave(Sender: TObject);
procedure imgOkClick(Sender: TObject);
procedure tCloseTimer(Sender: TObject);
private
{ Private declarations }
Mutex_: TTgMutex;
nClose_: Integer;
sTitle_: String;
bLCount_,
bIsNoExit_: Boolean;
procedure SetImgBtn(nImgIdx: Integer);
public
{ Public declarations }
Constructor Create(aOwner: TComponent; dwCustomerType: DWORD; bLicenseCnt, bIsNoExit: Boolean; sMsg: String);
procedure CreateParams(var Params: TCreateParams); override;
Destructor Destroy; override;
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
end;
var
DlgLicense: TDlgLicense;
implementation
uses
Tocsg.Exception, superobject, GlobalDefine, Condition, ProcessParam, DefineHelper;
resourcestring
RS_FMT_CutTimer = '미동의 시 %d초 후 네트워크가 차단 됩니다.';
RS_SecuAgree = '보안 사용 동의';
RS_SecuAgree_ABL = 'ABL생명 정보보안 서약서 동의';
{$R *.dfm}
Constructor TDlgLicense.Create(aOwner: TComponent; dwCustomerType: DWORD; bLicenseCnt, bIsNoExit: Boolean; sMsg: String);
var
O: ISuperObject;
begin
Inherited Create(aOwner);
sTitle_ := '';
bLCount_ := bLicenseCnt;
bIsNoExit_ := bIsNoExit;
Mutex_ := TTgMutex.Create(MUTEX_LICENSE);
SetImgBtn(0);
if dwCustomerType = CUSTOMER_KR then
begin
nClose_ := 300;
mmGuide.Lines.Add(KR_VPN_DESC);
end else begin
nClose_ := 60;
mmGuide.Lines.Add(DEF_VPN_DESC);
end;
if bLCount_ then
lbCloseMsg.Caption := Format(RS_FMT_CutTimer, [nClose_])
else
lbCloseMsg.Visible := false;
if dwCustomerType = CUSTOMER_ABL then
begin
Label1.Caption := RS_SecuAgree_ABL;
Label1.Font.Color := clRed;
end else
Label1.Caption := RS_SecuAgree;
try
if sMsg <> '' then
begin
O := SO(sMsg);
if (O <> nil) and (O.O['resultStr'] <> nil) and
(O.O['resultStr'].S['eulatitle'] <> '') then
begin
sTitle_ := O.O['resultStr'].S['eulatitle'];
lbSecureAgree.Caption := sTitle_;
mmAgree.Text := StringReplace(O.O['resultStr'].S['eulacontent'], '\r\n', #13#10, [rfReplaceAll]);
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Create()');
end;
tInit.Enabled := true;
end;
procedure TDlgLicense.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := WS_EX_APPWINDOW;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
Params.WndParent := GetDesktopWindow;
end;
Destructor TDlgLicense.Destroy;
begin
FreeAndNil(Mutex_);
Inherited;
end;
procedure TDlgLicense.imgMainMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
procedure TDlgLicense.imgOkClick(Sender: TObject);
var
sAgree: String;
begin
sAgree := Trim(edAgree.Text);
if (sAgree = '동의합니다') or (sAgree = '동의합니다.') then
begin
// gMgSvc.AgentModel.EulaDT := Now;
// gMgSvc.AgentModel.Save;
gParam.SendData(HPCMD_LICENSE_AGREE, '');
Close;
end;
end;
procedure TDlgLicense.imgOkMouseEnter(Sender: TObject);
begin
SetImgBtn(1);
end;
procedure TDlgLicense.imgOkMouseLeave(Sender: TObject);
begin
SetImgBtn(0);
end;
procedure TDlgLicense.SetImgBtn(nImgIdx: Integer);
begin
imgBtnList.GetIcon(nImgIdx, imgOk.Picture.Icon);
imgOk.Repaint
end;
procedure TDlgLicense.tCloseTimer(Sender: TObject);
begin
Dec(nClose_);
lbCloseMsg.Caption := Format(RS_FMT_CutTimer, [nClose_]);
if nClose_ <= 0 then
begin
tClose.Enabled := false;
// gMgSvc.VulService.SetDisconnect(true, true);
gParam.SendData(HPCMD_LICENSE_DISCONN, '');
if not bIsNoExit_ then
begin
Close;
end else begin
// 다시 반복 22_0725 14:07:04 kku
// 반복되지 않도록 요청 사항 들어옴 (KR) 22_0809 16:50:40 kku
// if CUSTOMER_TYPE = CUSTOMER_KR then
// nClose_ := 300
// else
// nClose_ := 60;
// tClose.Enabled := true;
lbCloseMsg.Visible := false;
end;
end;
Application.ProcessMessages;
end;
procedure TDlgLicense.tInitTimer(Sender: TObject);
begin
tInit.Enabled := false;
if MuTex_.MutexState <> msCreateOk then
Close;
// FormStyle := fsNormal;
if bLCount_ then
begin
lbCloseMsg.Visible := true;
tClose.Enabled := true;
end;
end;
procedure TDlgLicense.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
begin
if msg.CmdType = SC_CLOSE then
exit;
Inherited;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,167 @@
unit DUserInfoAgree;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.pngimage,
Vcl.ExtCtrls, System.ImageList, Vcl.ImgList, PngImageList;
type
TDlgUserInfoAgree = class(TForm)
imgMain: TImage;
Label1: TLabel;
lbDate: TLabel;
Label2: TLabel;
edName: TEdit;
mmInfo: TMemo;
chAgree: TCheckBox;
edAgree: TEdit;
imgBtnList: TPngImageList;
imgOk: TImage;
imgBtnList2: TPngImageList;
imgClose: TImage;
Shape1: TShape;
procedure imgOkMouseEnter(Sender: TObject);
procedure imgOkMouseLeave(Sender: TObject);
procedure imgCloseMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseMouseEnter(Sender: TObject);
procedure imgCloseMouseLeave(Sender: TObject);
procedure imgCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseClick(Sender: TObject);
procedure imgOkClick(Sender: TObject);
procedure chAgreeClick(Sender: TObject);
procedure imgMainMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure edAgreeKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
procedure SetImgBtn(aImgList: TPngImageList; imgBtn: TImage; nImgIdx: Integer);
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
end;
var
DlgUserInfoAgree: TDlgUserInfoAgree;
implementation
uses
ProcessParam, DefineHelper;
{$R *.dfm}
Constructor TDlgUserInfoAgree.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
SetImgBtn(imgBtnList, imgOk, 0);
SetImgBtn(imgBtnList2, imgClose, 0);
lbDate.Caption := DateTimeToStr(Now);
Application.Title := Caption;
end;
procedure TDlgUserInfoAgree.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
// Params.ExStyle := WS_EX_APPWINDOW;
// Params.WndParent := GetDesktopWindow;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
procedure TDlgUserInfoAgree.edAgreeKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
if imgOk.Enabled then
imgOkClick(nil);
Key := #0;
end;
end;
procedure TDlgUserInfoAgree.SetImgBtn(aImgList: TPngImageList; imgBtn: TImage; nImgIdx: Integer);
begin
aImgList.GetIcon(nImgIdx, imgBtn.Picture.Icon);
imgBtn.Repaint
end;
procedure TDlgUserInfoAgree.chAgreeClick(Sender: TObject);
begin
imgOk.Enabled := chAgree.Checked;
end;
procedure TDlgUserInfoAgree.imgCloseClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TDlgUserInfoAgree.imgCloseMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SetImgBtn(imgBtnList2, imgClose, 2);
end;
procedure TDlgUserInfoAgree.imgCloseMouseEnter(Sender: TObject);
begin
SetImgBtn(imgBtnList2, imgClose, 1);
end;
procedure TDlgUserInfoAgree.imgCloseMouseLeave(Sender: TObject);
begin
SetImgBtn(imgBtnList2, imgClose, 0);
end;
procedure TDlgUserInfoAgree.imgCloseMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
imgCloseMouseEnter(Sender);
end;
procedure TDlgUserInfoAgree.imgMainMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
procedure TDlgUserInfoAgree.imgOkClick(Sender: TObject);
begin
edName.Text := Trim(edName.Text);
edAgree.Text := Trim(edAgree.Text);
if edName.Text = '' then
begin
MessageBox(Handle, PChar('이름을 입력해 주십시오.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edName.SetFocus;
exit;
end;
if (edAgree.Text <> '동의합니다') and (edAgree.Text <> '동의합니다.') then
begin
MessageBox(Handle, PChar('"동의합니다"를 입력해 주십시오.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edAgree.SetFocus;
exit;
end;
gParam.SendData(HPCMD_PERSONALINFO_AGREE, '');
Close;
// ModalResult := mrOk;
end;
procedure TDlgUserInfoAgree.imgOkMouseEnter(Sender: TObject);
begin
if chAgree.Checked then
SetImgBtn(imgBtnList, imgOk, 1);
end;
procedure TDlgUserInfoAgree.imgOkMouseLeave(Sender: TObject);
begin
SetImgBtn(imgBtnList, imgOk, 0);
end;
end.

View File

@ -0,0 +1,702 @@
{*******************************************************}
{ }
{ ProcessParam }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit ProcessParam;
interface
uses
System.SysUtils, Winapi.Windows, Winapi.Messages, Tocsg.Param, Vcl.Clipbrd,
CttSchDefine, System.Classes;
type
TNetScanInfo = record
llTasker: LONGLONG;
FileScanOpt: TFileScanOpt;
sTgNetDir: String;
dwCustomType: DWORD;
end;
TDrmInfo = record
sUName, sDept, sEmpNo, sPoName: String;
bApproval: Boolean;
end;
TProcessParam = class(TTgParam)
private
hRcvWnd_: HWND;
nParamCnt_: Integer;
sOwnerMtx_: String;
nRole_: Integer;
NetSI_: TNetScanInfo;
DrmI_: TDrmInfo;
procedure SelectFileFromOpenDialog(sFilter: String; nCtrl: Integer);
procedure SelectFolderFromFileOpenDialog(nCtrl: Integer);
public
Constructor Create;
Destructor Destroy; override;
function IsParamOK: Boolean;
procedure SendData(dwCmd: DWORD; const sData: String);
property RcvWnd: HWND read hRcvWnd_;
property Role: Integer read nRole_;
property OwnerMtx: String read sOwnerMtx_;
property NetSI: TNetScanInfo read NetSI_;
property DrmI: TDrmInfo read DrmI_;
end;
var
gParam: TProcessParam = nil;
implementation
uses
superobject, DefineHelper, Winapi.ShlObj, Vcl.Dialogs, Tocsg.Process,
Tocsg.Path, Tocsg.Shell, GlobalOutAddInDefine, DLicense, DQnA, Define,
Vcl.Forms, DAfterReport, DUserInfoAgree, Vcl.Imaging.pngimage, Tocsg.Safe,
Vcl.Graphics, CrmUtil, Tocsg.Trace, Tocsg.Exception, Tocsg.Strings,
Winapi.ShellAPI, Tocsg.Clipboard, DReqDevExcept, Tocsg.Json, DDecryptDrm,
Condition, Tocsg.Network, DEncryptDrm, Tocsg.Hash, Soap.EncdDecd,
Winapi.WinSpool, Tocsg.Printer;
function GetSpecialDir(nFolder: Integer): String;
var
pidl: PItemIDList;
hRes: HRESULT;
bSuccess: Boolean;
sRealPath: array [0..MAX_PATH] of {$IFDEF UNICODE} WideChar {$ELSE} AnsiChar {$ENDIF};
begin
Result := '';
bSuccess := false;
hRes := SHGetSpecialFolderLocation(0, nFolder, pidl);
if hRes = NO_ERROR then
bSuccess := SHGetPathFromIDList(pidl, sRealPath);
if bSuccess = true then
Result := IncludeTrailingPathDelimiter(sRealPath);
end;
function GetDesktopDir: String;
begin
Result := GetSpecialDir(CSIDL_DESKTOPDIRECTORY);
end;
function GetRunExePath: String;
begin
Result := ParamStr(0);
end;
function GetRunExePathDir: String;
begin
Result := ExtractFilePath(GetRunExePath);
end;
{ TProcessParam }
Constructor TProcessParam.Create;
begin
Inherited Create;
ASSERT(gParam = nil);
gParam := Self;
nParamCnt_ := ParamCount;
hRcvWnd_ := 0;
nRole_ := 0;
ZeroMemory(@NetSI_, SizeOf(NetSI_));
ZeroMemory(@DrmI_, SizeOf(DrmI_));
end;
Destructor TProcessParam.Destroy;
begin
gParam := nil;
Inherited;
end;
procedure TProcessParam.SendData(dwCmd: DWORD; const sData: String);
var
CopyData: TCopyDataStruct;
begin
CopyData.dwData := dwCmd;
CopyData.cbData := (Length(sData) + 1) * 2;
CopyData.lpData := PChar(sData);
SendMessage(hRcvWnd_, WM_COPYDATA, 0, NativeInt(@CopyData));
end;
procedure TProcessParam.SelectFileFromOpenDialog(sFilter: String; nCtrl: Integer);
var
OpenDialog: TOpenDialog;
O: ISuperObject;
i: Integer;
begin
OpenDialog := TOpenDialog.Create(nil);
OpenDialog.Filter := sFilter;
OpenDialog.FileName := '';
OpenDialog.InitialDir := GetDesktopDir;
if nCtrl = 99 then
OpenDialog.Options := OpenDialog.Options + [ofAllowMultiSelect];
if OpenDialog.Execute(0) then
begin
O := SO;
O.S['Path'] := OpenDialog.FileName;
O.I['Ctrl'] := nCtrl;
if nCtrl = 99 then
begin
var OA: ISuperObject := TSuperObject.Create(stArray);
for i := 0 to OpenDialog.Files.Count - 1 do
OA.AsArray.Add(OpenDialog.Files[i]);
O.O['List'] := OA;
end;
SendData(HPCMD_SELECT_FILE, O.AsString);
end;
OpenDialog.Free;
end;
procedure TProcessParam.SelectFolderFromFileOpenDialog(nCtrl: Integer);
var
OpenDialog: TFileOpenDialog;
O: ISuperObject;
begin
OpenDialog := TFileOpenDialog.Create(nil);
OpenDialog.FileName := '';
OpenDialog.DefaultFolder := GetDesktopDir;
OpenDialog.Options := OpenDialog.Options + [fdoPickFolders];
if OpenDialog.Execute(0) then
begin
O := SO;
O.S['Path'] := OpenDialog.FileName;
O.I['Ctrl'] := nCtrl;
SendData(HPCMD_SELECT_FOLDER, O.AsString);
end;
OpenDialog.Free;
end;
function GetCbData(aO: ISuperObject; var sBody: String; var sOcrBody: String; var sImgPath: String): Boolean;
var
CB: TClipboard;
hCb: THandle;
bmp: Vcl.Graphics.TBitmap;
png: TPngImage;
sTemp: String;
nLen: Integer;
arrFName: array [0..MAX_PATH-1] of WideChar;
i: Integer;
bFail,
// bIsExcel,
bExtrImg: Boolean;
nTry: Integer;
Label
LB_TryReadCB;
begin
Result := false;
Guard(CB, TClipboard.Create);
nTry := 0;
// bIsExcel := aO.B['IsExcel2'];
LB_TryReadCB :
bFail := false;
try
bExtrImg := not aO.B['IgrImgCB'];
if CB.HasFormat(CF_UNICODETEXT) then
begin
if CB.GetSize < 10000 then
begin
sTemp := Trim(CB.AsText);
// if bIsExcel then
// begin
// nLen := Length(sTemp);
// if nLen > 10000 then
// begin
// bExtrImg := false;
// SetLength(sTemp, 5000);
// sTemp := sTemp + Format(' ... (OrgSize=%d)', [InsertPointComma(nLen, 3)]);
// end;
// end;
if sTemp <> '' then
sBody := sTemp;
end else
bExtrImg := false;
end else
if CB.HasFormat(CF_TEXT) then
begin
if CB.GetSize < 10000 then
begin
sTemp := Trim(CB.AsText);
// if bIsExcel then
// begin
// nLen := Length(sTemp);
// if nLen > 10000 then
// begin
// bExtrImg := false;
// SetLength(sTemp, 5000);
// sTemp := sTemp + Format(' ... (OrgSize=%d)', [InsertPointComma(nLen, 3)]);
// end;
// end;
if sTemp <> '' then
sBody := sTemp;
end else
bExtrImg := false;
end else
if CB.HasFormat(CF_HDROP) then
begin
sTemp := '';
hCb := CB.GetAsHandle(CF_HDROP);
if hCb <> 0 then
begin
GlobalLock(hCb);
try
nLen := DragQueryFile(hCb, DWORD(-1), nil, MAX_PATH);
for i := 0 to nLen - 1 do
begin
if DragQueryFile(hCb, i, arrFName, MAX_PATH) <> 0 then
SumString(sTemp, arrFName, '|');
end;
finally
GlobalUnlock(hCb);
end;
end;
if sTemp <> '' then
sBody := sTemp;
end;
if bExtrImg and CB.HasFormat(CF_BITMAP) then
begin
hCb := CB.GetAsHandle(CF_BITMAP);
if hCb <> 0 then
begin
GlobalLock(hCb);
try
try
Guard(bmp, Vcl.Graphics.TBitmap.Create);
bmp.LoadFromClipboardFormat(CF_BITMAP, hCb, CB.GetAsHandle(CF_PALETTE));
Guard(png, TPngImage.Create);
png.Assign(bmp);
sTemp := 'C:\ProgramData\HE\Task\';
if ForceDirectories(sTemp) then
begin
sTemp := sTemp + FormatDateTime('yyyymmddhhnnss', Now) + '.png';
png.SaveToFile(sTemp);
if FileExists(sTemp) then
begin
sImgPath := sTemp;
if aO.B['DoClipOcr'] then
sOcrBody := ExtrTextFromImage(sImgPath);
end;
end else begin
TTgTrace.T('Fail .. GetCbData() .. creatDir');
exit;
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetCbData() .. make image');
end;
finally
GlobalUnlock(hCb);
end;
end;
end;
Result := true;
except
on E: EClipboardException do
bFail := true;
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetCbData()');
end;
if bFail then
begin
if nTry < 5 then
begin
Inc(nTry);
Sleep(500);
goto LB_TryReadCB;
end;
end;
end;
function TProcessParam.IsParamOK: Boolean;
var
sPath,
sTemp: String;
O: ISuperObject;
bDel: Boolean;
i: Integer;
Jobs: array [0..9] of JOB_INFO_1;
begin
Result := false;
if ExistsParam('-hook') then
begin
var sDllPath: String := CutFileExt(GetRunExePath) + '32.dll';
if FileExists(sDllPath) then
Result := InjectModule(StrToInt64Def(GetParamValue('-hook'), 0), sDllPath) <> 0;
end else
if ExistsParam('-hook2') then
begin
var sDllPath: String := CutFileExt(GetRunExePath) + '32f.dll';
if FileExists(sDllPath) then
Result := InjectModule(StrToInt64Def(GetParamValue('-hook2'), 0), sDllPath) <> 0;
end else
if ExistsParam('-clearhook') then
begin
var sDllPath: String := CutFileExt(GetRunExePath) + '32.dll';
var sDllPath2: String := CutFileExt(GetRunExePath) + '32f.dll';
if FileExists(sDllPath) then
begin
EjectModuleFromPath(sDllPath + '|' + sDllPath2);
Sleep(1000);
EjectModuleFromPath(sDllPath + '|' + sDllPath2);
end;
end else
if ExistsParam('-pjob') then
begin
sPath := GetParamValue('-pjob');
i := StrToIntDef(GetParamValue('-c'), -1);
if i = -1 then
exit;
var nJobId: Integer := StrToIntDef(GetParamValue('-j'), -1);;
if nJobId = -1 then
exit;
var hPrt: THandle := 0;
var dwNed, dwRet: DWORD;
if OpenPrinter(PChar(sPath), hPrt, nil) then
begin
SetJob(hPrt, nJobId, 0, nil, i);
ClosePrinter(hPrt);
end;
end else begin
sPath := GetParamValue('/p');
if sPath = '' then
sPath := GetParamValue('-p');
if (sPath = '') or not FileExists(sPath) then
sPath := GetRunExePathDir + DAT_PARAM;
bDel := true;
try
if not LoadJsonObjFromFile(O, sPath) then
exit;
if O.B['RunAs'] then
begin
bDel := false;
// 관리자 권한으로 실행 추가 23_0504 12:41:16 kku
O.B['RunAs'] := false;
sTemp := 'C:\ProgramData\HE\Task\';
if ForceDirectories(sTemp) and SaveJsonObjToFile(O, sTemp + DAT_PARAM) then
begin
ExecutePath_runAs(GetRunExePath, Format('/p "%s"', [sTemp + DAT_PARAM]));
exit;
end;
end;
finally
if bDel then
DeleteFile(PChar(sPath));
end;
hRcvWnd_ := O.I['RcvWnd'];
if O.I['CT'] <> 0 then
CUSTOMER_TYPE := O.I['CT'];
case O.I['Cmd'] of
HPCMD_SELECT_FILE : SelectFileFromOpenDialog(O.S['Filter'], O.I['Ctrl']);
HPCMD_SELECT_FOLDER : SelectFolderFromFileOpenDialog(O.I['Ctrl']);
HPCMD_EXECUTE_FILE :
begin
sPath := O.S['Path'];
sTemp := O.S['Param'];
if CompareText(sPath, 'explorer.exe') = 0 then
begin
// explorer.exe라면... 재시작을 의미하기로 한다 23_0227 14:58:18 kku
// TerminateProcessByName(sPath);
ExecutePath_hide('cmd.exe', '/c taskkill /f /im explorer.exe');
Sleep(500);
end;
if O.B['Hide'] then
ExecutePath_hide(sPath, sTemp)
else if O.B['Open'] then
OpenPath(sPath)
else
ExecutePath(sPath, sTemp);
end;
HPCMD_OPEN_SELECT : ExplorerSelectedPath(O.S['Path']);
// HPCMD_SHOW_NOTIFICATION
HPCMD_INSTALL_OUTLOOK_ADDIN :
begin
InstallOutlookAddin(O.S['MdDir']);
SendData(HPCMD_INSTALL_OUTLOOK_ADDIN, '');
end;
HPCMD_UNINSTALL_OUTLOOK_ADDIN :
begin
sTemp := O.S['MdDir'];
ExecutePath_hide('regsvr32.exe', Format('/u /s "%s"', [sTemp + DLL_ADDIN]));
ExecutePath_hide('regsvr32.exe', Format('/u /s "%s"', [sTemp + DLL_ADDIN64]));
end;
HPCMD_LICENSE_AGREE :
begin
var dlg: TDlgLicense :=
TDlgLicense.Create(nil, O.I['CT'], O.B['Count'], O.B['NoExit'], O.S['Msg']);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_PERSONALINFO_AGREE :
begin
var dlg: TDlgUserInfoAgree := TDlgUserInfoAgree.Create(nil);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_SEND_QnA_MESSAGE :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
var dlg: TDlgQnA := TDlgQnA.Create(nil);
dlg.Label1.Caption := O.S['Desc'];
dlg.lbOk.Caption := O.S['BtnOk'];
dlg.lbCancel.Caption := O.S['BtnCancel'];
dlg.ShowModal;
dlg.Free;
end;
HPCMD_INPUT_EXCEPT_REASON :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
var dlg: TDlgQnA := TDlgQnA.Create(nil);
dlg.ReqCmd := HPCMD_INPUT_EXCEPT_REASON;
dlg.MinStrLen := O.I['MinTL'];
dlg.sMinInputMsg := O.S['MinMsg'];
dlg.Caption := O.S['Title'];
dlg.Label1.Caption := O.S['Desc'];
dlg.lbOk.Caption := O.S['BtnOk'];
dlg.ShowModal;
dlg.Free;
end;
HPCMD_REQ_DEVICE_EXCEPT :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
var ReqInfo: TReqDevExceptInfo := TTgJson.GetDataAsType<TReqDevExceptInfo>(O.O['ReqInfo']);
var dlg: TDlgReqDevExcept := TDlgReqDevExcept.Create(nil, ReqInfo);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_SEND_AFTER_REPORT :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
var dlg: TDlgAfterReport := TDlgAfterReport.Create(nil);
dlg.SetInfo(O.S['UserName'], O.D['AfterRptDT']);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_REQ_CLIPBOARD_DATA :
begin
var sBody, sOcrBody, sImgPath: String;
if GetCbData(O, sBody, sOcrBody, sImgPath) then
begin
var OData: ISuperObject := SO;
OData.S['Body'] := sBody;
OData.S['OcrBody'] := sOcrBody;
OData.S['ImgPath'] := sImgPath;
OData.S['WinCap'] := O.S['WinCap'];
OData.S['AName'] := O.S['AName'];
OData.S['APath'] := O.S['APath'];
OData.I['AWnd'] := O.I['AWnd'];
SendData(HPCMD_REQ_CLIPBOARD_DATA, OData.AsString);
end;
end;
HPCMD_REQ_NETDIR_SCAN :
begin
nRole_ := O.I['Cmd'];
sOwnerMtx_ := O.S['Mtx'];
NetSI_.llTasker := O.I['Tasker'];
NetSI_.FileScanOpt := TTgJson.GetDataAsType<TFileScanOpt>(O.O['FOpt']);
NetSI_.dwCustomType := O.I['CT'];
NetSI_.sTgNetDir := O.S['TgNDir'];
hRcvWnd_ := NetSI_.FileScanOpt.CttSchOpt.hRcvHwnd;
end;
HPCMD_REQ_NETDRVADDR :
begin
var fs: TFileStream;
Guard(fs, TFileStream.Create(PChar(O.S['OutPath']), fmCreate));
var sData: UTF8String := NetDriveToRemoteAddr(O.S['NetDrv']);
fs.Write(PAnsiChar(sData)^, Length(sData));
exit;
end;
HPCMD_OPEN_ENCRYPT :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
DrmI_.sUName := O.S['UName'];
DrmI_.sDept := O.S['Dept'];
DrmI_.sEmpNo := O.S['EN'];
DrmI_.sPoName := O.S['PON'];
var FList: TStringList;
Guard(FList, TStringList.Create);
if (O.O['Files'] <> nil) and (O.O['Files'].DataType = stArray) then
begin
for i := 0 to O.A['Files'].Length - 1 do
Flist.Add(O.A['Files'].S[i]);
end;
var dlg: TDlgEncryptDrm := TDlgEncryptDrm.Create(nil);
if Flist.Count > 0 then
dlg.AddFiles(FList);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_OPEN_DECRYPT :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
DrmI_.sUName := O.S['UName'];
DrmI_.sDept := O.S['Dept'];
DrmI_.sEmpNo := O.S['EN'];
DrmI_.sPoName := O.S['PON'];
DrmI_.bApproval := O.B['AVAL'];
var FList: TStringList;
Guard(FList, TStringList.Create);
if (O.O['Files'] <> nil) and (O.O['Files'].DataType = stArray) then
begin
for i := 0 to O.A['Files'].Length - 1 do
Flist.Add(O.A['Files'].S[i]);
end;
var dlg: TDlgDecryptDrm := TDlgDecryptDrm.Create(nil);
if Flist.Count > 0 then
dlg.AddFiles(FList);
dlg.ShowModal;
dlg.Free;
end;
HPCMD_REQ_DECRYPT :
begin
APP_TITLE := O.S['WinCap'];
Application.Title := APP_TITLE;
DrmI_.sUName := O.S['UName'];
DrmI_.sDept := O.S['Dept'];
DrmI_.sEmpNo := O.S['EN'];
DrmI_.sPoName := O.S['PON'];
var FList: TStringList;
Guard(FList, TStringList.Create);
if (O.O['DecFiles'] <> nil) and (O.O['DecFiles'].DataType = stArray) then
begin
for i := 0 to O.A['DecFiles'].Length - 1 do
begin
sPath := O.A['DecFiles'].O[i].S['filePath'];
if FileExists(sPath) and (O.A['DecFiles'].O[i].S['hash'] = GetFileToSha1Str(sPath)) then
Flist.Add(sPath);
end;
end;
var dlg: TDlgDecryptDrm := TDlgDecryptDrm.Create(nil);
if Flist.Count > 0 then
dlg.AddFiles(FList);
var n1, n2, n3: Integer;
dlg.DoDecFiles(n1, n2, n3);
dlg.SetReadOnly;
dlg.FormStyle := fsStayOnTop;
dlg.ShowModal;
dlg.Free;
end;
HPCMD_COPY_FILE :
begin
var sSrc: String := O.S['Src'];
var sDest: String := O.S['Dest'];
if FileExists(sSrc) then
CopyFile(PChar(sSrc), PChar(sDest), false);
end;
HPCMD_REQ_FILEICON :
begin
sPath := O.S['P'];
var ico: TIcon := GetFileSmallIcon(sPath);
var ms: TMemoryStream := TMemoryStream.Create;
ico.SaveToStream(ms);
var OInfo: ISuperObject := SO;
OInfo.I['N'] := O.I['N'];
OInfo.S['E'] := O.S['E'];
OInfo.S['D'] := EncodeBase64(ms.Memory, ms.Size);
SendData(HPCMD_REQ_FILEICON, OInfo.AsJSon);
ms.Free;
ico.Free;
end;
HPCMD_CTRL_PRINTER :
begin
sPath := O.S['P'];
i := O.I['C'];
var nJobId: Integer := O.I['J'];
var hPrt: THandle := 0;
var dwNed, dwRet: DWORD;
if OpenPrinter(PChar(sPath), hPrt, nil) then
SetJob(hPrt, nJobId, 0, nil, i);
end;
HPCDM_PRINT_INFO_LIST :
begin
var PrtsInfo: TPrintersInfo;
Guard(PrtsInfo, TPrintersInfo.Create);
PrtsInfo.RefreshList;
PrtsInfo.SaveToFile(O.S['P']);
end
else
begin
nRole_ := O.I['Cmd'];
sOwnerMtx_ := O.S['Mtx'];
end;
end;
Result := true;
end;
end;
end.

View File

@ -0,0 +1,107 @@
program eCrmHeHelper;
uses
Tocsg.Safe in '..\..\Tocsg.Lib\VCL\Tocsg.Safe.pas',
Tocsg.Trace in '..\..\Tocsg.Lib\VCL\Tocsg.Trace.pas',
Tocsg.Path in '..\..\Tocsg.Lib\VCL\Tocsg.Path.pas',
Tocsg.Files in '..\..\Tocsg.Lib\VCL\Tocsg.Files.pas',
Tocsg.Obj in '..\..\Tocsg.Lib\VCL\Tocsg.Obj.pas',
Tocsg.Encrypt in '..\..\Tocsg.Lib\VCL\Tocsg.Encrypt.pas',
Tocsg.Exception in '..\..\Tocsg.Lib\VCL\Tocsg.Exception.pas',
Tocsg.Binary in '..\..\Tocsg.Lib\VCL\Tocsg.Binary.pas',
Tocsg.Hash in '..\..\Tocsg.Lib\VCL\Tocsg.Hash.pas',
Tocsg.Thread in '..\..\Tocsg.Lib\VCL\Tocsg.Thread.pas',
Tocsg.Json in '..\..\Tocsg.Lib\VCL\Tocsg.Json.pas',
Tocsg.DateTime in '..\..\Tocsg.Lib\VCL\Tocsg.DateTime.pas',
Tocsg.Strings in '..\..\Tocsg.Lib\VCL\Tocsg.Strings.pas',
Tocsg.Hex in '..\..\Tocsg.Lib\VCL\Tocsg.Hex.pas',
Tocsg.Param in '..\..\Tocsg.Lib\VCL\Tocsg.Param.pas',
Tocsg.Process in '..\..\Tocsg.Lib\VCL\Tocsg.Process.pas',
Tocsg.FileInfo in '..\..\Tocsg.Lib\VCL\Tocsg.FileInfo.pas',
Tocsg.Kernel32 in '..\..\Tocsg.Lib\VCL\Tocsg.Kernel32.pas',
Tocsg.WndUtil in '..\..\Tocsg.Lib\VCL\Tocsg.WndUtil.pas',
Tocsg.WinInfo in '..\..\Tocsg.Lib\VCL\Tocsg.WinInfo.pas',
Tocsg.Registry in '..\..\Tocsg.Lib\VCL\Tocsg.Registry.pas',
Tocsg.Shell in '..\..\Tocsg.Lib\VCL\Tocsg.Shell.pas',
Tocsg.Win32 in '..\..\Tocsg.Lib\VCL\Tocsg.Win32.pas',
Tocsg.WTS in '..\..\Tocsg.Lib\VCL\Tocsg.WTS.pas',
Tocsg.Graphic in '..\..\Tocsg.Lib\VCL\Tocsg.Graphic.pas',
Tocsg.Clipboard in '..\..\Tocsg.Lib\VCL\Tocsg.Clipboard.pas',
Tocsg.Convert in '..\..\Tocsg.Lib\VCL\Tocsg.Convert.pas',
Tocsg.VTUtil in '..\..\Tocsg.Lib\VCL\Tocsg.VTUtil.pas',
Tocsg.User32 in '..\..\Tocsg.Lib\VCL\Tocsg.User32.pas',
Tocsg.Network in '..\..\Tocsg.Lib\VCL\Tocsg.Network.pas',
Tocsg.Driver in '..\..\Tocsg.Lib\VCL\Tocsg.Driver.pas',
Tocsg.Disk in '..\..\Tocsg.Lib\VCL\Tocsg.Disk.pas',
Tocsg.WMI in '..\..\Tocsg.Lib\VCL\Tocsg.WMI.pas',
Tocsg.Service in '..\..\Tocsg.Lib\VCL\Tocsg.Service.pas',
Tocsg.Printer in '..\..\Tocsg.Lib\VCL\Tocsg.Printer.pas',
superobject in '..\..\Tocsg.Lib\VCL\SuperObject\superobject.pas',
aes_type in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_type.pas',
aes_cbc in '..\..\Tocsg.Lib\VCL\EncLib\AES\aes_cbc.pas',
BTypes in '..\..\Tocsg.Lib\VCL\EncLib\AES\BTypes.pas',
AES_Base in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Base.pas',
AES_Encr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Encr.pas',
AES_Decr in '..\..\Tocsg.Lib\VCL\EncLib\AES\AES_Decr.pas',
EM.MD5 in '..\..\Tocsg.Lib\VCL\EncLib\EM.MD5.pas',
EM.CRC32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.CRC32.pas',
EM.Tocsg.sha256 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.sha256.pas',
EM.Tocsg.Sha1 in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.Sha1.pas',
EM.Tocsg.hash in '..\..\Tocsg.Lib\VCL\EncLib\EM.Tocsg.hash.pas',
EM.WtsApi32 in '..\..\Tocsg.Lib\VCL\EncLib\EM.WtsApi32.pas',
EM.winioctl in '..\..\Tocsg.Lib\VCL\Other\EM.winioctl.pas',
EM.GSStorage in '..\..\Tocsg.Lib\VCL\Other\EM.GSStorage.pas',
EM.WinOSVersion in '..\..\Tocsg.Lib\VCL\Other\EM.WinOSVersion.pas',
EM.nduWlanAPI in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanAPI.pas',
EM.nduCType in '..\..\Tocsg.Lib\VCL\Other\EM.nduCType.pas',
EM.nduL2cmn in '..\..\Tocsg.Lib\VCL\Other\EM.nduL2cmn.pas',
EM.nduWlanTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduWlanTypes.pas',
EM.nduWinDot11 in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinDot11.pas',
EM.nduWinNT in '..\..\Tocsg.Lib\VCL\Other\EM.nduWinNT.pas',
EM.nduEapTypes in '..\..\Tocsg.Lib\VCL\Other\EM.nduEapTypes.pas',
EM.nduNtDDNdis in '..\..\Tocsg.Lib\VCL\Other\EM.nduNtDDNdis.pas',
EM.WbemScripting_TLB in '..\..\Tocsg.Lib\VCL\Other\EM.WbemScripting_TLB.pas',
Forms,
DefineHelper in 'DefineHelper.pas',
ProcessParam in 'ProcessParam.pas',
DHeHelperMain in 'DHeHelperMain.pas' {DlgHeHelperMain},
GlobalOutAddInDefine in '..\DLL_BS1OutlookAddIn\GlobalOutAddInDefine.pas',
DLicense in 'Messages\DLicense.pas' {DlgLicense},
GlobalDefine in '..\LIB_Common\GlobalDefine.pas',
Condition in '..\LIB_Common\Condition.pas',
DQnA in '..\EXE_eCrmHomeEdition\Messages\DQnA.pas' {DlgQnA},
Define in 'Define.pas',
DAfterReport in '..\EXE_eCrmHomeEdition\Messages\DAfterReport.pas' {DlgAfterReport},
DUserInfoAgree in 'Messages\DUserInfoAgree.pas' {DlgUserInfoAgree},
CrmUtil in '..\LIB_Common\CrmUtil.pas',
DReqDevExcept in '..\EXE_eCrmHomeEdition\Messages\DReqDevExcept.pas' {DlgReqDevExcept},
CttSchDefine in '..\..\Tocsg.Module\ContentSearch\LIB_Common\CttSchDefine.pas',
DDecryptDrm in '..\EXE_eCrmHomeEdition\DRM\DDecryptDrm.pas' {DlgDecryptDrm},
Tocsg.DRM.Encrypt in '..\..\Tocsg.Module\TocsgDRM\LIB_Common\Tocsg.DRM.Encrypt.pas',
DEncryptDrm in '..\EXE_eCrmHomeEdition\DRM\DEncryptDrm.pas' {DlgEncryptDrm};
{$R *.res}
var
param: TProcessParam;
trace: TTgTrace;
begin
Guard(param, TProcessParam.Create);
{$IFDEF DEBUG}
Guard(trace, TTgTrace.Create('C:\taskToCSG\eCrmHE\OUT_Debug - Win32\', 'Hlp.log'));
{$ENDIF}
if not param.IsParamOK then
exit;
if (param.Role = 0) or (param.OwnerMtx = '') then
exit;
Application.Initialize;
Application.MainFormOnTaskbar := true;
Application.ShowMainForm := false;
Application.CreateForm(TDlgHeHelperMain, DlgHeHelperMain);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,159 @@
unit DUserInfoAgree;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.pngimage,
Vcl.ExtCtrls, System.ImageList, Vcl.ImgList, PngImageList;
type
TDlgUserInfoAgree = class(TForm)
imgMain: TImage;
Label1: TLabel;
lbDate: TLabel;
Label2: TLabel;
edName: TEdit;
mmInfo: TMemo;
chAgree: TCheckBox;
edAgree: TEdit;
imgBtnList: TPngImageList;
imgOk: TImage;
imgBtnList2: TPngImageList;
imgClose: TImage;
Shape1: TShape;
procedure imgOkMouseEnter(Sender: TObject);
procedure imgOkMouseLeave(Sender: TObject);
procedure imgCloseMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseMouseEnter(Sender: TObject);
procedure imgCloseMouseLeave(Sender: TObject);
procedure imgCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseClick(Sender: TObject);
procedure imgOkClick(Sender: TObject);
procedure chAgreeClick(Sender: TObject);
procedure imgMainMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure edAgreeKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
procedure SetImgBtn(aImgList: TPngImageList; imgBtn: TImage; nImgIdx: Integer);
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
end;
var
DlgUserInfoAgree: TDlgUserInfoAgree;
implementation
{$R *.dfm}
Constructor TDlgUserInfoAgree.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
SetImgBtn(imgBtnList, imgOk, 0);
SetImgBtn(imgBtnList2, imgClose, 0);
lbDate.Caption := DateTimeToStr(Now);
end;
procedure TDlgUserInfoAgree.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
// Params.ExStyle := WS_EX_APPWINDOW;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
procedure TDlgUserInfoAgree.edAgreeKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
if imgOk.Enabled then
imgOkClick(nil);
Key := #0;
end;
end;
procedure TDlgUserInfoAgree.SetImgBtn(aImgList: TPngImageList; imgBtn: TImage; nImgIdx: Integer);
begin
aImgList.GetIcon(nImgIdx, imgBtn.Picture.Icon);
imgBtn.Repaint
end;
procedure TDlgUserInfoAgree.chAgreeClick(Sender: TObject);
begin
imgOk.Enabled := chAgree.Checked;
end;
procedure TDlgUserInfoAgree.imgCloseClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
procedure TDlgUserInfoAgree.imgCloseMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SetImgBtn(imgBtnList2, imgClose, 2);
end;
procedure TDlgUserInfoAgree.imgCloseMouseEnter(Sender: TObject);
begin
SetImgBtn(imgBtnList2, imgClose, 1);
end;
procedure TDlgUserInfoAgree.imgCloseMouseLeave(Sender: TObject);
begin
SetImgBtn(imgBtnList2, imgClose, 0);
end;
procedure TDlgUserInfoAgree.imgCloseMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
imgCloseMouseEnter(Sender);
end;
procedure TDlgUserInfoAgree.imgMainMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
procedure TDlgUserInfoAgree.imgOkClick(Sender: TObject);
begin
edName.Text := Trim(edName.Text);
edAgree.Text := Trim(edAgree.Text);
if edName.Text = '' then
begin
MessageBox(Handle, PChar('이름을 입력해 주십시오.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edName.SetFocus;
exit;
end;
if (edAgree.Text <> '동의합니다') and (edAgree.Text <> '동의합니다.') then
begin
MessageBox(Handle, PChar('"동의합니다"를 입력해 주십시오.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edAgree.SetFocus;
exit;
end;
ModalResult := mrOk;
end;
procedure TDlgUserInfoAgree.imgOkMouseEnter(Sender: TObject);
begin
if chAgree.Checked then
SetImgBtn(imgBtnList, imgOk, 1);
end;
procedure TDlgUserInfoAgree.imgOkMouseLeave(Sender: TObject);
begin
SetImgBtn(imgBtnList, imgOk, 0);
end;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More