BSOne.SFC/Tocsg.Module/EtcCtrl/EXE_EtcCtrl/DEtcCtrlMain.pas

232 lines
6.0 KiB
Plaintext
Raw Permalink 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 DEtcCtrlMain;
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;
type
TInstallPrintHook = function: Integer; stdcall;
TUninstallPrintHook = function: Integer; stdcall;
TDlgPtrMkMain = class(TForm)
btnHook: TButton;
tMtx: TTimer;
tBlockOpen: TTimer;
Button2: TButton;
procedure btnHookClick(Sender: TObject);
procedure tMtxTimer(Sender: TObject);
procedure tBlockOpenTimer(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
bLoader_,
bActive_: Boolean;
SharedData_: TTgFileMapping<TSharedData>;
hHookDLL_: THandle;
Mtx32Hook_: TTgMutex;
function LoadHookDLL: Boolean;
function FreeHookDLL: Boolean;
procedure SetSharedData(bActive: Boolean);
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
end;
var
DlgPtrMkMain: TDlgPtrMkMain;
implementation
uses
Tocsg.Path, Tocsg.Safe, Vcl.Imaging.pngimage, Tocsg.WinInfo, Tocsg.Network,
Tocsg.Shell, Tocsg.Param, Tocsg.Process, Winapi.TlHelp32, Tocsg.Exception;
{$R *.dfm}
Constructor TDlgPtrMkMain.Create(aOwner: TComponent);
var
param: TTgParam;
begin
Inherited Create(aOwner);
Guard(param, TTgParam.Create);
bLoader_ := param.ExistsParam('-loader');
if not bLoader_ then
begin
SharedData_ := TTgFileMapping<TSharedData>.Create(MAP_FILENAME_APIHOOK, SizeOf(TSharedData));
ZeroMemory(SharedData_.Data, SizeOf(SharedData_.Data));
end else
SharedData_ := nil;
bActive_ := false;
Mtx32Hook_ := nil;
DeleteFile(PChar(GetRunExePathDir + LOG_FILE));
hHookDLL_ := 0;
if not bLoader_ and (Pos('32.exe', GetRunExePath) > 0) then
TerminateProcess(GetCurrentProcess, 0);
if bLoader_ then
begin
LoadHookDLL;
tMtx.Enabled := true;
end;
end;
Destructor TDlgPtrMkMain.Destroy;
begin
if Mtx32Hook_ <> nil then
FreeAndNil(Mtx32Hook_);
FreeHookDLL;
Inherited;
if SharedData_ <> nil then
FreeAndNil(SharedData_);
end;
procedure TDlgPtrMkMain.SetSharedData(bActive: Boolean);
begin
// edText.Text := Trim(edText.Text);
// edImgPath.Text := Trim(edImgPath.Text);
// with SharedData_ do
// begin
// bActive_ := bActive;
// Data.bActive := bActive_;
// Data.nLineCnt := StrToIntDef(Trim(edLineCnt.Text), 4);
// Data.nFontSize := StrToIntDef(Trim(edFontSize.Text), 175);
// StrCopy(Data.simgPath, PWideChar(edImgPath.Text));
// StrCopy(Data.sText, PWideChar(edText.Text));
// StrCopy(Data.sLogPath, PWideChar(GetRunExePathDir + LOG_FILE));
// end;
end;
procedure TDlgPtrMkMain.tBlockOpenTimer(Sender: TObject);
var
h: HWND;
sPName: String;
begin
// h := FindWindowEx(0, 0, '#32770', '<27><><EFBFBD><EFBFBD>');
h := FindWindowEx(0, 0, '#32770', nil);
sPName := GetProcessNameFromWndHandle(h);
if (sPName = 'chrome.exe') or (sPName = 'msedge.exe') then
SendMessage(h, WM_CLOSE, 0, 0);
end;
procedure TDlgPtrMkMain.tMtxTimer(Sender: TObject);
begin
if not MutexExists(HOOK_MUTEX) then
Close;
end;
procedure TDlgPtrMkMain.btnHookClick(Sender: TObject);
begin
if not bActive_ then
begin
if hHookDLL_ = 0 then
begin
if not LoadHookDLL then
begin
MessageBox(Handle, PChar('DLL<4C><4C> <20>ε<EFBFBD><CEB5>ϴ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
end;
SetSharedData(true);
MessageBox(Handle, PChar('APP <20><><EFBFBD><20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end else begin
if not FreeHookDLL then
begin
MessageBox(Handle, PChar('DLL<4C><4C> <20>ε带 <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
MessageBox(Handle, PChar('APP <20><><EFBFBD><20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
if hHookDLL_ <> 0 then
btnHook.Caption := 'APP <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>'
else
btnHook.Caption := 'APP <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
Application.ProcessMessages;
end;
function TDlgPtrMkMain.LoadHookDLL: Boolean;
var
sDllPath: String;
fnInstallPrintHook: TInstallPrintHook;
nResult: Integer;
begin
Result := false;
if hHookDLL_ = 0 then
begin
sDllPath := GetRunExePathDir + DLL_APIHOOK;
if EjectModuleFromPath(sDllPath) > 0 then
Sleep(2000);
if FileExists(sDllPath) then
begin
hHookDLL_ := LoadLibrary(PChar(sDllPath));
if hHookDLL_ <> 0 then
begin
fnInstallPrintHook := nil;
@fnInstallPrintHook := GetProcAddress(hHookDLL_, 'InstallPrintHook');
if @fnInstallPrintHook <> nil then
begin
nResult := fnInstallPrintHook;
if nResult <> 0 then
begin
FreeLibrary(hHookDLL_);
hHookDLL_ := 0;
end else begin
Result := true;
if not IsWow64 then
begin
Mtx32Hook_ := TTgMutex.Create(HOOK_MUTEX);
if Mtx32Hook_.MutexState = msCreateOk then
begin
var sPath32: String := CutFileExt(GetRunExePath) + '32.exe';
if FileExists(sPath32) then
ExecutePath_hide(sPath32, '-loader');
end;
end;
end;
end;
end;
end;
end;
end;
function TDlgPtrMkMain.FreeHookDLL: Boolean;
var
fnUnInstallPrintHook: TUninstallPrintHook;
begin
Result := false;
if hHookDLL_ > 0 then
begin
EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK); // <20>ι<EFBFBD> 1/2
@fnUnInstallPrintHook := nil;
@fnUnInstallPrintHook := GetProcAddress(hHookDLL_, 'UninstallPrintHook');
if @fnUnInstallPrintHook <> nil then
fnUnInstallPrintHook;
FreeLibrary(hHookDLL_);
hHookDLL_ := 0;
EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK); // <20>ι<EFBFBD> 2/2
Result := true;
end;
end;
procedure TDlgPtrMkMain.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(EjectModuleFromPath(GetRunExePathDir + DLL_APIHOOK)));
end;
end.