unit BS1OverlayIconAip; {$WARN SYMBOL_PLATFORM OFF} interface uses Windows, ActiveX, Classes, ComObj, StdVcl, Winapi.ShlObj, System.SysUtils, Winapi.Messages; const TASK_DIR: String = 'C:\ProgramData\HE\AEN\'; type TBSOneOverlayIcon = class(TComObject, IShellIconOverlayIdentifier) protected { IShellExtInit } function IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD): HResult; stdcall; function GetPriority(out pIPriority: Integer): HResult; stdcall; function GetOverlayInfo(pwszIconFile: PWideChar; cchMax: Integer; var pIndex: Integer; var pdwFlags: DWORD): HResult; stdcall; end; TBSOneOverlayIconFac = class(TComObjectFactory) public procedure UpdateRegistry(bRegister: Boolean); override; end; const Class_BSOneOverlayIcon: TGUID = '{F82EE40A-71BE-44D8-873A-CE4FB6B54265}'; implementation uses System.Win.ComServ, Winapi.ShellAPI, System.Win.Registry, Tocsg.Path, Tocsg.Safe, CttSchDefine, Tocsg.Strings, Tocsg.Encrypt, Tocsg.FileInfo, Tocsg.AIP, Tocsg.Files; var _AipOvExtList: TStringList = nil; function SendCopyData(hRcv: HWND; nCmd: Integer; sData: String): LRESULT; stdcall; inline; var CopyData: TCopyDataStruct; 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); Result := SendMessage(hRcv, WM_COPYDATA, 0, NativeInt(@CopyData)); except // ... end; end; { TBSOneOverlayIcon } function TBSOneOverlayIcon.IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD): HResult; stdcall; var sPath, sExt: String; bIsEnc: Boolean; begin Result := S_FALSE; sPath := pwszPath; try sExt := GetFileExt(sPath).ToUpper; if _AipOvExtList.IndexOf(sExt) <> -1 then begin DeleteDirSub(TASK_DIR); bIsEnc := false; if sExt = 'PDF' then begin bIsEnc := IsAipEncrytedPDF(sPath); end else if CheckMsPfileExt(sPath) then begin bIsEnc := IsAipEncrytedOldOfficeDoc(sPath, TASK_DIR); if not bIsEnc then bIsEnc := IsAipEncrytedOfficeDoc(sPath, TASK_DIR); end else if (sExt = 'DOCX') or (sExt = 'XLSX') or (sExt = 'PPTX') or (sExt = 'DOCM') or (sExt = 'DOTX') or (sExt = 'XLSM') or (sExt = 'XLSB') then begin bIsEnc := IsAipEncrytedOfficeDoc(sPath, TASK_DIR); end; if bIsEnc then Result := S_OK; end; except // .. end; // if GetFileExt(sPath).ToUpper = 'DOCX' then // Result := S_OK; // if GetFileExt(sPath).ToUpper = 'TXT' then // begin // Guard(StrList, TStringList.Create); // try // StrList.LoadFromFile(sPath, TEncoding.UTF8); // except // StrList.LoadFromFile(sPath); // end; // // if Pos('tocsg', StrList.Text) > 0 then // Result := S_OK; // end; // if (dwAttrib and faReadonly) = faReadonly then // Result := S_OK // else // Result := S_FALSE; end; function TBSOneOverlayIcon.GetPriority(out pIPriority: Integer): HResult; stdcall; begin pIPriority := 0; Result := S_OK; end; function TBSOneOverlayIcon.GetOverlayInfo(pwszIconFile: PWideChar; cchMax: Integer; var pIndex: Integer; var pdwFlags: DWORD): HResult; stdcall; var sOverIconPath: WideString; begin sOverIconPath := 'C:\Program Files\Tocsg\eCrmHome\conf\Bs1aip.dat'; pIndex := 0; lstrcpynW(pwszIconFile, PWideChar(sOverIconPath), cchMax); pdwFlags := ISIOI_ICONFILE or ISIOI_ICONINDEX; Result := S_OK; end; { TBSOneOverlayIconFac } procedure TBSOneOverlayIconFac.UpdateRegistry(bRegister: Boolean); var ClassID: string; begin if bRegister then begin inherited UpdateRegistry(bRegister); ClassID := GUIDToString(Class_BSOneOverlayIcon); CreateRegKey('Software\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\ BSOne2', '', ClassID, HKEY_LOCAL_MACHINE); if (Win32Platform = VER_PLATFORM_WIN32_NT) then with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True); OpenKey('Approved', True); WriteString(ClassID, 'BSone-AIP Icon Overlay Shell Extension'); finally Free; end; end else begin DeleteRegKey('Software\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifiers\ BSOne2', HKEY_LOCAL_MACHINE); inherited UpdateRegistry(bRegister); end; end; initialization _AipOvExtList := TStringList.Create; _AipOvExtList.CaseSensitive := false; SplitString(AIP_EXTS, '|', _AipOvExtList); TBSOneOverlayIconFac.Create(ComServer, TBSOneOverlayIcon, Class_BSOneOverlayIcon, 'BSOneAipOverIcon', 'BSOne-AIP', ciMultiInstance, tmApartment); finalization FreeAndNil(_AipOvExtList); end.