BSOne.SFC/Tocsg.Module/TocsgDRM/EXE_TocsgDRM/DTgDrmMain.pas

344 lines
8.6 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

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

unit DTgDrmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, GlobalDefine,
Tocsg.CommonData, Vcl.ExtCtrls, Vcl.Buttons, Tocsg.Win32, Tocsg.Controls,
Tocsg.Process;
type
TInstallDrmHook = function: Integer; stdcall;
TUninstallDrmHook = function: Integer; stdcall;
TDlgTgDrmMain = class(TForm)
pnTop: TPanel;
pnClient: TPanel;
btnHook: TButton;
Button2: TButton;
GroupBox2: TGroupBox;
mmTgApp: TMemo;
procedure btnHookClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
sDllPath_: String;
bIsWow64_: Boolean;
MgCtrls_: TManagerInputControlsData;
TgAppList_: TStringList;
ThdAppMon_: TThdProcessWatch;
SharedData_: TTgFileMapping<TSharedData>;
bActive_: Boolean;
hHookDLL_: THandle;
MtxHook_: TTgMutex;
procedure OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
function StartHookWatch: Boolean;
function StopHookWatch: Boolean;
procedure SetSharedData(aActive: Boolean);
function LoadHookDLL: Boolean;
function FreeHookDLL: Boolean;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
end;
var
DlgTgDrmMain: TDlgTgDrmMain;
implementation
uses
Tocsg.Path, Tocsg.Safe, Vcl.Imaging.pngimage, Tocsg.WinInfo, Tocsg.Network,
Tocsg.Shell, Tocsg.Param, Winapi.TlHelp32, Tocsg.Exception,
Tocsg.Capture, Tocsg.Strings, Tocsg.User32, Tocsg.Trace;
{$R *.dfm}
Constructor TDlgTgDrmMain.Create(aOwner: TComponent);
var
param: TTgParam;
begin
Inherited Create(aOwner);
{$IFDEF WIN64}
Caption := 'TocsgDRM64';
{$ELSE}
Caption := 'TocsgDRM32';
{$ENDIF}
hHookDLL_ := 0;
MtxHook_ := nil;
MgCtrls_ := nil;
Guard(param, TTgParam.Create);
MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
MgCtrls_.RegInputCtrl(mmTgApp);
MgCtrls_.Load;
sDllPath_ := GetRunExePathDir + DLL_APIHOOK;
bIsWow64_ := IsWow64;
TgAppList_ := TStringList.Create;
TgAppList_.CaseSensitive := false;
ThdAppMon_ := nil;
bActive_ := false;
if mmTgApp.Text = '' then
mmTgApp.Text := 'winword.exe|excel.exe|POWERPNT.EXE|notepad.exe';
SharedData_ := TTgFileMapping<TSharedData>.Create(MAP_FILENAME_APIHOOK, SizeOf(TSharedData));
ZeroMemory(SharedData_.Data, SizeOf(SharedData_.Data));
DeleteFile(PChar(GetRunExePathDir + LOG_FILE));
{$IFDEF DEBUG}
Button2.Enabled := true;
Button2.Visible := true;
{$ENDIF}
// SetWindowDisplayAffinity(Handle, $11);
SetWindowDisplayAffinity(Handle, 1);
// SetWindowDisplayAffinity(3939212, 1);
// ShowMessage(IntToStr(FindWindow(nil, '<27><><EFBFBD>ο<EFBFBD> 1 - Notepad++')));
end;
Destructor TDlgTgDrmMain.Destroy;
begin
if MgCtrls_ <> nil then
FreeAndNil(MgCtrls_);
if ThdAppMon_ <> nil then
FreeAndNil(ThdAppMon_);
FreeAndNil(TgAppList_);
if MtxHook_ <> nil then
FreeAndNil(MtxHook_);
Inherited;
if SharedData_ <> nil then
FreeAndNil(SharedData_);
end;
function TDlgTgDrmMain.LoadHookDLL: Boolean;
var
sDllPath,
sPath64: String;
fnInstallDrmHook: TInstallDrmHook;
nResult: Integer;
begin
Result := false;
if hHookDLL_ = 0 then
begin
// EjectModuleFromPath(sDllPath_);
SplitString(mmTgApp.Text, '|', TgAppList_);
sDllPath := GetRunExePathDir + DLL_APIHOOK;
if FileExists(sDllPath) then
begin
hHookDLL_ := LoadLibrary(PChar(sDllPath));
if hHookDLL_ <> 0 then
begin
fnInstallDrmHook := nil;
@fnInstallDrmHook := GetProcAddress(hHookDLL_, 'InstallDrmHook');
if @fnInstallDrmHook <> nil then
begin
SetSharedData(true);
nResult := fnInstallDrmHook;
if nResult <> 0 then
begin
FreeLibrary(hHookDLL_);
hHookDLL_ := 0;
end else begin
Result := true;
{$IFNDEF DEBUG}
if not IsWow64 then
begin
MtxHook_ := TTgMutex.Create(HOOK_MUTEX);
if MtxHook_.MutexState = msCreateOk then
begin
sPath64 := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sPath64) then
ExecutePath_hide(sPath64);
end;
end;
{$ENDIF}
end;
end;
end;
end;
end;
end;
function TDlgTgDrmMain.FreeHookDLL: Boolean;
var
fnUnInstallDrmHook: TUninstallDrmHook;
begin
Result := false;
if hHookDLL_ > 0 then
begin
SetSharedData(false);
if MtxHook_ <> nil then
FreeAndNil(MtxHook_);
@fnUnInstallDrmHook := nil;
@fnUnInstallDrmHook := GetProcAddress(hHookDLL_, 'UnInstallDrmHook');
if @fnUnInstallDrmHook <> nil then
fnUnInstallDrmHook;
FreeLibrary(hHookDLL_);
hHookDLL_ := 0;
// {$IFDEF WIN64}
// var sExe32: String := CutFileExt(GetRunExePath) + '32.exe';
// if FileExists(sExe32) then
// ExecutePath(sExe32, '-clearhook');
// {$ENDIF}
TgAppList_.Clear;
// EjectModuleFromPath(sDllPath_);
// Sleep(500);
// EjectModuleFromPath(sDllPath_);
Result := true;
end;
end;
procedure TDlgTgDrmMain.OnAppNotify(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind);
begin
case aKind of
pwkUnknown : {$IFDEF DEBUG} ASSERT(false) {$ENDIF};
pwkInit,
pwkExecute :
begin
if TgAppList_.IndexOf(pEnt.sPName) = -1 then
exit;
if InjectModule(pEnt.dwPid, sDllPath_, @bIsWow64_) > 0 then
begin
TTgTrace.T('InjectModule() .. PName="%s"', [pEnt.sPName]);
end else begin
{$IFDEF WIN64}
var sExe32: String := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sExe32) then
ExecutePath(sExe32, Format('-hook %d', [pEnt.dwPid]));
{$ENDIF}
TTgTrace.T('Fail .. InjectModule() .. PName="%s"', [pEnt.sPName]);
end;
end;
pwkTerminated : ;
end;
end;
function TDlgTgDrmMain.StartHookWatch: Boolean;
begin
Result := false;
if ThdAppMon_ = nil then
begin
try
EjectModuleFromPath(sDllPath_);
SplitString(mmTgApp.Text, '|', TgAppList_);
ThdAppMon_ := TThdProcessWatch.Create;
ThdAppMon_.OnProcessWatchNotify := OnAppNotify;
ThdAppMon_.StartThread;
SetSharedData(true);
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StartHookWatch()');
end;
end;
end;
function TDlgTgDrmMain.StopHookWatch: Boolean;
begin
Result := false;
if ThdAppMon_ <> nil then
begin
try
SetSharedData(false);
{$IFDEF WIN64}
var sExe32: String := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sExe32) then
ExecutePath(sExe32, '-clearhook');
{$ENDIF}
ThdAppMon_.OnProcessWatchNotify := nil;
FreeAndNil(ThdAppMon_);
TgAppList_.Clear;
EjectModuleFromPath(sDllPath_);
Sleep(500);
EjectModuleFromPath(sDllPath_);
bActive_ := false;
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. StopHookWatch()');
end;
end;
end;
procedure TDlgTgDrmMain.SetSharedData(aActive: Boolean);
begin
bActive_ := aActive;
with SharedData_.Data^ do
begin
bActive := bActive_;
llRcvWnd := Handle;
// StrCopy(sPass, PWideChar(PASS_DRM));
StrCopy(sTgPNames, PWideChar(mmTgApp.Text));
StrCopy(sLogPath, PWideChar(GetRunExePathDir + LOG_FILE));
end;
end;
procedure TDlgTgDrmMain.btnHookClick(Sender: TObject);
begin
if not bActive_ then
begin
mmTgApp.Text := Trim(mmTgApp.Text);
if mmTgApp.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> APP<50><50> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MgCtrls_.Save;
if not StartHookWatch then
// if not LoadHookDLL then
begin
MessageBox(Handle, PChar('DLL<4C><4C> <20>ε<EFBFBD><CEB5>ϴ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MessageBox(Handle, PChar('DRM <20><><EFBFBD><20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end else begin
StopHookWatch;
// FreeHookDLL;
MessageBox(Handle, PChar('DRM <20><><EFBFBD><20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
mmTgApp.Enabled := not bActive_;
if bActive_ then
begin
btnHook.Caption := 'DRM <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
end else begin
btnHook.Caption := 'DRM <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
end;
Application.ProcessMessages;
end;
procedure TDlgTgDrmMain.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK)));
end;
end.