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

unit ApiHookExplorer;

interface

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

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
{$IFDEF _BS1HP_}
  BS1Hook, DefineHelper, GlobalDefine, superobject, AppCtrlDefine, ApiHookContents, BsoneDebug,
{$ELSE}
  AppHook,
{$ENDIF}
  DDetours;

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);
    @_OzPerformOperations := nil;
  end;
end;

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

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

  bAdviseOk := false;
  FoSink := TFileOpProgressSink.Create as IFileOperationProgressSink;
  if FoSink <> nil then
  begin
    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
            @_OzPerformOperations := InterceptCreate(@_FndPerformOperations, @PerformOperationsHook);
            if (@_OzPerformOperations <> nil) then
              Dbg('PerformOperations() .. OK')
            else
              Dbg('PerformOperations() .. Fail');
          end else
            Dbg('FndPerformOperations() .. Fail');
        finally
          EndTransaction(hTx);
        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 IsPathDeviceType(sPath: string): DWORD;
var
  sChk: String;
begin
  Result := 0;
  if Length(sPath) >= 2 then
  begin
    sChk := UpperCase(sPath);
    if Pos('\APPDATA\ROAMING\MICROSOFT\WINDOWS\NETWORK SHORTCUTS\', sChk) > 0 then
    begin
      Result := 0;
      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
        case GetDriveType(PChar(sChk[1] + ':\')) of
          DRIVE_CDROM:
          begin
            Result := DRIVE_CDROM;
            exit;
          end;
          DRIVE_REMOVABLE:
          begin
            Result := DRIVE_REMOVABLE;
            exit;
          end;
          DRIVE_FIXED:
          begin
            Result := 0;
            exit;
          end;
          DRIVE_REMOTE,
          DRIVE_NO_ROOT_DIR :
          begin
            Result := DRIVE_REMOTE;
            exit;
          end;
        end;
    end;

    if (sChk[1] = '\') and (sChk[2] = '\') then
    begin
      Result := DRIVE_REMOTE;
      Exit;
    end;

    Result := 0;
  end;
end;

function ProcMon(evt: TEvtType; const sSrcPath, sDstDir: String; sFName: String): HRESULT;
var
  deviceType: DWORD;
  isNetFile: Boolean;
  FileUseBlock: TFileUseBlock;
  resultMsg: string;
  curAppType: TCurAppType;

  function IsExceptionExtenstion(const APath: string; var AtExt : string): Boolean;
  var
    sExt: string;
    ExceptionExt: TArray<string>;
    Ext: string;
  begin
    Result:= False;

    if AtExt <> '' then
    begin
      ExceptionExt := AtExt.Split(['|']);

      for Ext in ExceptionExt do
      begin
        if Trim(Ext) = '' then
          Continue;

        if SameText(sExt, Ext) then
        begin
          Result := True;
          exit;
        end;
      end;
    end;

  end;

  function IsExceptionPath(const APath: string; var AtPath : string): Boolean;
  var
    ExceptionPaths: TArray<string>;
    ExPath: string;
  begin
    Result:= False;

    if AtPath <> '' then
    begin
      ExceptionPaths := AtPath.Split(['|']);

      for ExPath in ExceptionPaths do
      begin
        if Trim(ExPath) = '' then
          Continue;

        if ContainsText(APath, ExPath) then
        begin
          Result := True;
          exit;
        end;
      end;
    end;

  end;
begin
  Result := S_OK;
  resultMsg := '';

  if (gAppHook = nil) then
    Exit;

  if (gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind = 0) and
    (gAppHook.Helper.CtrlOpt.FileUseBlock = fubNone) and
    (gAppHook.Helper.CtrlOpt.IntCdromBlockNewFile.mode = abkNone) and
    (gAppHook.Helper.CtrlOpt.IntUsbBlockNewFile.mode = abkNone) then
    Exit;

  var sDstPath: String;
  var bBlock: Boolean;
  if sFName = '' then
    sFName := ExtractFileName(sSrcPath);

  sDstPath := IncludeTrailingPathDelimiter(sDstDir) + sFName;

  deviceType:= IsPathDeviceType(sDstPath);
  if deviceType = 0 then
    Exit;

  DVLOG('ProcMon: deviceType(%d), evt(%d), ShFileCrMon.nKind(%d), FileUseBlock(%d), sSrcPath(%s) -> sDstPath(%s)',
    [deviceType, DWORD(evt), gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind, DWORD(gAppHook.Helper.CtrlOpt.FileUseBlock), sSrcPath, sDstPath]);

  if(deviceType = DRIVE_REMOTE) and (gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind <> 0) then
  begin
    bBlock := gAppHook.Helper.CtrlOpt.ShFileCrMon.nKind = 2;
    isNetFile := True;
    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;

{$IFDEF _BS1HP_}
    var O: ISuperObject := SO;
    O.I['T'] := deviceType;
    O.S['S'] := sSrcPath;
    O.S['D'] := sDstPath;
    O.I['E'] := Integer(evt);
    O.B['B'] := bBlock;
    O.B['N'] := isNetFile; // 네트워크 파일?
    SendCopyData(gAppHook.Helper.CtrlOpt.hRcvWnd, HPCMD_FILE_OPERATION_NOTI, O.AsJSon);
{$ENDIF}
  end
  else
  begin
    var IntBlockNewFile: TIntBlockNewFile;
    var deviceName: string;
    case deviceType of
      DRIVE_CDROM:
      begin
        deviceName:= 'CDROM';
        curAppType:= catCdrom;
        IntBlockNewFile:= gAppHook.Helper.CtrlOpt.IntCdromBlockNewFile;
      end;
      DRIVE_REMOVABLE:
      begin
        deviceName:= 'REMOVABLE';
        curAppType:= catUsb;
        IntBlockNewFile:= gAppHook.Helper.CtrlOpt.IntUsbBlockNewFile;
      end;
      else
        exit;
    end;

    if IntBlockNewFile.mode = abkNone then
      exit
    else if IntBlockNewFile.mode = abkBlock then
      FileUseBlock := fubBlock
    else
      FileUseBlock := fubMonitor;

    if IsExceptionExtenstion(sSrcPath, IntBlockNewFile.extList) then
      exit;

    if IsExceptionPath(sSrcPath, IntBlockNewFile.excList) then
      exit;

    DVLOG('ProcMon: mode(%d), blockByFilename(%s), contentsFilter(%s)',
      [DWORD(IntBlockNewFile.mode), IntBlockNewFile.blockByFilename_list, IntBlockNewFile.contentsFilter_list]);

    if FileUseBlock = fubBlock then
      bBlock:= CheckAppPolicy(FileUseBlock, sSrcPath, IntBlockNewFile);

    bBlock:= CheckContentPolicy(curAppType, FileUseBlock, sSrcPath, IntBlockNewFile, resultMsg);

    if not bBlock then
    begin
      DVLOG('ProcMon: MATCHING!!!!!ALLOW!!!!!(%d)', [DWORD(bBlock)]);
      SendHeCopyMessage(curAppType, NOTI_HOOK_MONITOR_ATTACH, sSrcPath, True, deviceName, resultMsg);
//      ProcessNoti(NOTI_HOOK_MONITOR_ATTACH, sPath, True);
    end
    else
    begin
      DVLOG('ProcMon: MATCHING!!!!!BLOCK!!!!!(%d)', [DWORD(bBlock)]);
      SendHeCopyMessage(curAppType, NOTI_HOOK_BLOCK_ATTACH, sSrcPath, True, deviceName, resultMsg);
    end;
  end;

  if bBlock then
    Result := E_ACCESSDENIED;

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.