{*******************************************************}
{                                                       }
{       ApiHookExplorer                                 }
{                                                       }
{       Copyright (C) 2025 kku                          }
{                                                       }
{*******************************************************}

unit ApiHookExplorer;

interface

uses
  Winapi.Windows, System.SysUtils, Winapi.ActiveX, Tocsg.Thread, Winapi.ShlObj;

type
  TFileOpProgressSink = class(TInterfacedObject, IFileOperationProgressSink)
  public
    function StartOperations: HRESULT; stdcall;
    function FinishOperations(hrResult: HRESULT): HRESULT; stdcall;

    function PreRenameItem(dwFlags: DWORD; const psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
    function PostRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
                      pszNewName: LPCWSTR; hrRename: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;

    function PreMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
                      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
    function PostMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
                      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrMove: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;

    function PreCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
    function PostCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
      hrCopy: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;

    function PreDeleteItem(dwFlags: DWORD; const psiItem: IShellItem): HResult; stdcall;
    function PostDeleteItem(dwFlags: DWORD; const psiItem: IShellItem; hrDelete: HResult;
      const psiNewlyCreated: IShellItem): HResult; stdcall;

    function PreNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
      pszNewName: LPCWSTR): HResult; stdcall;
    function PostNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
      pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD;
      hrNew: HResult; const psiNewItem: IShellItem): HResult; stdcall;

    function UpdateProgress(iWorkTotal, iWorkSoFar: UINT): HRESULT; stdcall;
    function ResetTimer: HRESULT; stdcall;
    function PauseTimer: HRESULT; stdcall;
    function ResumeTimer: HRESULT; stdcall;
  end;

  TPerformOperations = function(iFO: IFileOperation): HRESULT; stdcall;
  TThdFoHookInit = class(TTgThread)
  protected
    procedure Execute; override;
  public
    Constructor Create;
  end;

function PerformOperationsHook(iFO: IFileOperation): HRESULT; stdcall;
procedure InstallFileOperationHooks;
procedure UninstallFileOperationHooks;

implementation

uses
  DefineHelper, SuperObject, GlobalDefine, BsoneDebug, madCodeHook, madStrings, madTypes,
  BsoneUtil,
  Bs1ContentsFlowPolicyUnit,
  BsoneMtpHook;

type
  TEvtType = (etCreate, etCopy, etMove, etDelete, etRename);

var
  _ozCoCreateInstance: Pointer = nil;
  _FndPerformOperations: TPerformOperations = nil;
  _OzPerformOperations: TPerformOperations = nil;

procedure InstallFileOperationHooks;
begin
  if @_OzPerformOperations = nil then
    TThdFoHookInit.Create;
end;

procedure UninstallFileOperationHooks;
begin
  if @_OzPerformOperations <> nil then
  begin
    //InterceptRemove(@_OzPerformOperations);
    UnhookCode(@_OzPerformOperations);
    @_OzPerformOperations := nil;
  end;
end;

procedure Dbg(sLog: String);
begin
//  if gAppHook <> nil then
//    gAppHook.Log(sLog);
  LOG('%s',[sLog]);
end;

function PerformOperationsHook(iFO: IFileOperation): HRESULT; stdcall;
var
  FoSink: IFileOperationProgressSink;
  dwCookie: DWORD;
  hr: HRESULT;
  bAdviseOk: Boolean;
begin
  if (ghooked_ = false) or (@_OzPerformOperations = nil) then
  begin
    Result := E_POINTER;
    exit;
  end;

  bAdviseOk := false;
  FoSink := TFileOpProgressSink.Create as IFileOperationProgressSink;
  if FoSink <> nil then
  begin

    gbsHook_.policy_.GetPolicy;

    dwCookie := 0;
    hr := iFO.Advise(FoSink, dwCookie);
    bAdviseOk := SUCCEEDED(hr);
    if not bAdviseOk then
      dwCookie := 0;

    try
      Result := _OzPerformOperations(iFO);
    finally
      if bAdviseOk and (dwCookie <> 0) then
      begin
        try
          iFO.Unadvise(dwCookie);
        except
        //
        end;
      end;
      FoSink := nil;
    end;
  end else
    Result := _OzPerformOperations(iFO);
end;

{ TThdFoHookInit }

Constructor TThdFoHookInit.Create;
begin
  Inherited Create;
  FreeOnTerminate := true;
  StartThread;
end;

function GetInterfaceMethod(Intf: Pointer; dwMethodIdx: Cardinal): Pointer;
var
  pp: PPointer;
begin
  pp := PPointer(Intf)^;
  Result := PPointer(NativeUInt(pp) + dwMethodIdx * SizeOf(Pointer))^;
end;

procedure TThdFoHookInit.Execute;
var
  hr: HRESULT;
  iFO: IFileOperation;
begin
  hr := CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);
  if FAILED(hr) then
  begin
    Dbg('Fail .. CoInitializeEx() .. 초기화 실패');
    exit;
  end;

  try
    while not Terminated and not GetWorkStop do
    begin
      Sleep(1000);

      iFO := nil;
      hr := CoCreateInstance(CLSID_FileOperation, nil, CLSCTX_ALL, IID_IFileOperation, iFO);
      if FAILED(hr) then
      begin
        Dbg('Fail .. CoCreateInstance() .. IFileOperation 객체 생성 실패');
        exit;
      end;

      Dbg('CoCreateInstance() .. OK');
      if (iFO <> nil) and (@_FndPerformOperations = nil) then
      begin
       // var hTx: THandle := BeginTransaction;
        try
          @_FndPerformOperations := GetInterfaceMethod(iFO, 21);
          if (@_FndPerformOperations <> nil) then
          begin
            CollectHooks;
//            @_OzPerformOperations := InterceptCreate(@_FndPerformOperations, @PerformOperationsHook);
            HookCode(@_FndPerformOperations, @PerformOperationsHook, @_OzPerformOperations);

            if (@_OzPerformOperations <> nil) then
              Dbg('PerformOperations() .. OK')
            else
              Dbg('PerformOperations() .. Fail');
          end else
            Dbg('FndPerformOperations() .. Fail');
        finally
//          EndTransaction(hTx);
          FlushHooks;
        end;
        break;
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

function ShellItemPath(psi: IUnknown): string;
var
  si: IShellItem;
  psz: LPWSTR;
  hr: HRESULT;
begin
  Result := '';
  if (psi <> nil) and Supports(psi, IShellItem, si) then
  begin
    psz := nil;
    hr := si.GetDisplayName(SIGDN_FILESYSPATH, psz);
    if Succeeded(hr) and (psz <> nil) then
    begin
      Result := psz;
      CoTaskMemFree(psz);
    end;
  end;
end;

function IsUNCPath(sPath: string; var deviceName: string): Boolean;
var
  sChk: String;
  driveType: DWORD;
begin
  Result := false;
  if Length(sPath) >= 2 then
  begin
    sChk := UpperCase(sPath);
    if Pos('\APPDATA\ROAMING\MICROSOFT\WINDOWS\NETWORK SHORTCUTS\', sChk) > 0 then
    begin
      Result := true;
      exit;
    end;

    if sChk[1] = 'C' then
      exit;

    if sChk[2] = ':' then
    begin
//      if gAppHook <> nil then
//      begin
//        Result := gAppHook.Helper.IsNetPath(sChk[1] + ':\');
//        if Result then
//          exit;
//      end else
        driveType:= GetDriveType(PChar(sChk[1] + ':\'));
        case driveType of
          DRIVE_CDROM:
          begin
            Result := true;
            deviceName:= 'cdrom';
            exit;
          end;
          DRIVE_REMOVABLE:
          begin
            Result := true;
            deviceName:= 'removalbe';
            exit;
          end;
          DRIVE_FIXED:
            exit;
          DRIVE_REMOTE,
          DRIVE_NO_ROOT_DIR :
          begin
            Result := true;
            deviceName:= 'remote';
            exit;
          end;
        end;
    end;

    Result := (sChk[1] = '\') and (sChk[2] = '\');
    deviceName:= 'remote';
  end;
end;

function ProcMon(evt: TEvtType; const sSrcPath, sDstDir: String; sFName: String): HRESULT;
var
  hReceiver: HWND;
  deviceName: string;
  devicePolicy: TDeviceControlPolicy;
  bBlock: Boolean;
  sDstPath: string;
begin
  Result := S_OK;

//  if (gAppHook <> nil) and (gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind <> 0) then
//  begin


//    if sFName = '' then
  bBlock:= False;
  sFName := ExtractFileName(sSrcPath);
  sDstPath := IncludeTrailingPathDelimiter(sDstDir) + sFName;

  LOG('ProcMon: (%d), (%s)->(%s)', [DWORD(evt), sSrcPath, sDstPath]);
  if IsUNCPath(sDstPath, deviceName) then
  begin
    LOG('ProcMon: deviceName(%s)', [deviceName]);
    if gbsHook_.policy_.GetDeviceControlPolicy(deviceName, devicePolicy) then
    begin

      if devicePolicy.policy_ = 1 then
      begin
        if UtilIsFileSizeOverBlockSize(sSrcPath, devicePolicy.fileSize_) then
        begin
          LOG('ProcMon: Block !!!!!!!!!!!', []);

          bBlock := True;
          Result := E_ACCESSDENIED;
        end;
      end;

      SendUI(bBlock, deviceName, sSrcPath, sDstPath);
    end;

  end;


//    begin
//      bBlock := gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind = 2;
//
//      if bBlock and (gAppHook.Helper.FoExpList.Count > 0) then
//      begin
//        var sChk: String := UpperCase(sDstPath);
//        var i: Integer;
//        for i := 0 to gAppHook.Helper.FoExpList.Count - 1 do
//        begin
//          if Pos(gAppHook.Helper.FoExpList[i], sChk) > 0 then
//          begin
//            bBlock := false;
//            break;
//          end;
//        end;
//      end;

end;

{ IFileOperationProgressSink }

function TFileOpProgressSink.StartOperations: HRESULT; stdcall;
begin
  Dbg('StartOperations');
  Result := S_OK;
end;

function TFileOpProgressSink.FinishOperations(hrResult: HRESULT): HRESULT; stdcall;
begin
  Dbg(Format('FinishOperations hr=0x%x', [hrResult]));
  Result := S_OK;
end;

function TFileOpProgressSink.PreRenameItem(dwFlags: DWORD; const psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
var
  sSrcPath: string;
begin
  sSrcPath := ShellItemPath(psiItem);
  Dbg(Format('PreRenameItem: %s -> %s', [sSrcPath, pszNewName]));
  Result := S_OK;
end;

function TFileOpProgressSink.PostRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
      pszNewName: LPCWSTR; hrRename: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
  Dbg(Format('PostRenameItem hr=0x%x', [hrRename]));
  Result := S_OK;
end;

function TFileOpProgressSink.PreMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
                      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
var
  sSrcPath, sDstDir: string;
begin
  sSrcPath := ShellItemPath(psiItem);
  sDstDir := ShellItemPath(psiDestinationFolder);
  Dbg(Format('PreMoveItem: %s -> %s\%s', [sSrcPath, sDstDir, pszNewName]));
  Result := ProcMon(etMove, sSrcPath, sDstDir, pszNewName);
end;

function TFileOpProgressSink.PostMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
                      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrMove: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
  Dbg(Format('PostMoveItem hr=0x%x', [hrMove]));
  Result := S_OK;
end;

function TFileOpProgressSink.PreCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
var
  sSrcPath, sDstDir: string;
begin
  sSrcPath := ShellItemPath(psiItem);
  sDstDir := ShellItemPath(psiDestinationFolder);
  Dbg(Format('PreCopyItem: %s -> %s\%s', [sSrcPath, sDstDir, pszNewName]));
  Result := ProcMon(etCopy, sSrcPath, sDstDir, pszNewName);
end;

function TFileOpProgressSink.PostCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
      const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
      hrCopy: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
  Dbg(Format('PostCopyItem hr=0x%x', [hrCopy]));
  Result := S_OK;
end;

function TFileOpProgressSink.PreDeleteItem(dwFlags: DWORD; const psiItem: IShellItem): HResult; stdcall;
var
  sSrcPath: String;
begin
  sSrcPath := ShellItemPath(psiItem);
  Dbg('PreDeleteItem: ' + sSrcPath);
  Result := S_OK; // MaybeBlock(boDelete, sSrcPath, '', '');
end;

function TFileOpProgressSink.PostDeleteItem(dwFlags: DWORD; const psiItem: IShellItem; hrDelete: HResult;
      const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
  Dbg(Format('PostDeleteItem hr=0x%x', [hrDelete]));
  Result := S_OK;
end;

function TFileOpProgressSink.PreNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
      pszNewName: LPCWSTR): HResult; stdcall;
var
  sDstDir: string;
begin
  sDstDir := ShellItemPath(psiDestinationFolder);
  Dbg(Format('PreNewItem: %s\%s', [sDstDir, pszNewName]));
  Result := ProcMon(etCreate, '', sDstDir, pszNewName);
end;

function TFileOpProgressSink.PostNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
      pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD;
      hrNew: HResult; const psiNewItem: IShellItem): HResult; stdcall;
begin
  Dbg(Format('PostNewItem hr=0x%x', [hrNew]));
  Result := S_OK;
end;

function TFileOpProgressSink.UpdateProgress(iWorkTotal, iWorkSoFar: UINT): HRESULT; stdcall;
begin
  Result := S_OK;
end;

function TFileOpProgressSink.ResetTimer: HRESULT; stdcall;
begin
  Result := S_OK;
end;

function TFileOpProgressSink.PauseTimer: HRESULT; stdcall;
begin
  Result := S_OK;
end;

function TFileOpProgressSink.ResumeTimer: HRESULT; stdcall;
begin
  Result := S_OK;
end;

end.