unit DEncryptDrm; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Menus, System.Generics.Collections; const WM_CLICK_DECRYPT = WM_USER + 8548; type PDrmEnt = ^TDrmEnt; TDrmEnt = record sDir, sExt, sFName: String; bDrm: Boolean; nImgIdx: Integer; end; TDlgEncryptDrm = class(TForm) pnTop: TPanel; pnClient: TPanel; vtList: TVirtualStringTree; btnEncrypt: TButton; Label1: TLabel; popFun: TPopupMenu; miDelFile: TMenuItem; miDelNoDrm: TMenuItem; N1: TMenuItem; miClear: TMenuItem; btnAddFile: TButton; btnAddDir: TButton; OpenDialog: TOpenDialog; FileOpenDialog: TFileOpenDialog; procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vtListPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure vtListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); procedure vtListAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure miDelFileClick(Sender: TObject); procedure miDelNoDrmClick(Sender: TObject); procedure btnEncryptClick(Sender: TObject); procedure vtListContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure miClearClick(Sender: TObject); procedure btnAddFileClick(Sender: TObject); procedure btnAddDirClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } FileImageList_: TImageList; vtListOldWndProc_: TWndMethod; CheckFList_: TStringList; DcNDrvIps_: TDictionary; sUName_, sDept_, sEmpNo_, sPoName_: String; procedure vtListWndProc(var msg: TMessage); function CountNorFile: Integer; procedure AddFile(sPath: String); function CheckNetPath(sPath: String): String; public { Public declarations } Constructor Create(aOwner: TComponent); override; procedure CreateParams(var Params: TCreateParams); override; // 작업표시줄에 표시 Destructor Destroy; override; procedure AddFiles(aList: TStringList); end; var DlgEncryptDrm: TDlgEncryptDrm; implementation uses {$IFDEF _HE_} ManagerService, ManagerModel, {$ENDIF} {$IFDEF _HE_HLP_} ProcessParam, {$ENDIF} Tocsg.Convert, Tocsg.Shell, Winapi.ShellAPI, Tocsg.Path, Tocsg.DRM.Encrypt, Tocsg.Encrypt, GlobalDefine, Condition, Tocsg.Files, Tocsg.Strings, Tocsg.VTUtil, superobject, DefineHelper, Define, Tocsg.Exception, Tocsg.Process, Tocsg.Trace, Tocsg.Network, Tocsg.Safe; resourcestring RS_MsgAddFile = '먼저 파일을 추가해 주십시오.'; RS_NoTgFile = '암호화 할 파일이 없습니다.'; RS_Q_DrmDec = 'DRM 적용을 하시겠습니까?'; RS_MsgError = '작업을 준비하는 중 오류가 발생했습니다.'; RS_CompleteWork1 = '작업을 완료했습니다.'; RS_CompleteWork2 = '(성공 : %d, 실패 : %d, 무시 : %d)'; RS_Q_Clear = '목록을 초기화 하시겠습니까?'; RS_SelExceptFile = '제외 할 파일을 선택해 주십시오.'; RS_Q_ExceptFile = '선택한 파일들을 제외 하시겠습니까?'; RS_NoExceptFile = '제외 할 파일이 없습니다.'; RS_DrmFileDragDrop = '대상 파일을 드래그/드롭 해주십시오.'; {$R *.dfm} Constructor TDlgEncryptDrm.Create(aOwner: TComponent); var hSysIcons: THandle; begin Inherited Create(aOwner); {$IFDEF _HE_} sUName_ := gMgSvc.UName; sDept_ := gMgSvc.DeptName; if sDept_ = '' then sDept_ := gMgSvc.ModePolicy.DeptName; sEmpNo_ := gMgSvc.EmpNo; sPoName_ := gMgSvc.ModePolicy.PolicyName; {$ENDIF} {$IFDEF _HE_HLP_} sUName_ := gParam.DrmI.sUName; sDept_ := gParam.DrmI.sDept; sEmpNo_ := gParam.DrmI.sEmpNo; sPoName_ := gParam.DrmI.sPoName; {$ENDIF} FileImageList_ := TImageList.Create(Self); FileImageList_.ShareImages := true; FileImageList_.BlendColor := clHighlight; hSysIcons := GetShellImageHandle; if hSysIcons <> 0 then begin FileImageList_.Handle := hSysIcons; vtList.Images := FileImageList_; end; DcNDrvIps_ := TDictionary.Create; // sParam_ := GetRunExePathDir + DIR_CONF + DAT_PARAM; // sOutPath_ := 'C:\ProgramData\HE\Task\'; // ForceDirectories(sOutPath_); // sOutPath_ := sOutPath_ + '$ND.dat'; CheckFList_ := TStringList.Create; CheckFList_.CaseSensitive := false; vtListOldWndProc_ := vtList.WindowProc; vtList.WindowProc := vtListWndProc; DragAcceptFiles(vtList.Handle, true); ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD); ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD); ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD); end; procedure TDlgEncryptDrm.CreateParams(var Params: TCreateParams); begin Inherited CreateParams(Params); {$IFDEF _HE_} Params.ExStyle := WS_EX_APPWINDOW; {$ENDIF} end; Destructor TDlgEncryptDrm.Destroy; begin FreeAndNil(CheckFList_); FreeAndNil(DcNDrvIps_); Inherited; end; procedure TDlgEncryptDrm.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; function TDlgEncryptDrm.CountNorFile: Integer; var pData: PDrmEnt; pNode: PVirtualNode; begin Result := 0; vtList.BeginUpdate; try pNode := vtList.GetFirst; while pNode <> nil do begin pData := vtList.GetNodeData(pNode); if not pData.bDrm then Inc(Result); pNode := vtList.GetNext(pNode); end; finally vtList.EndUpdate; end; end; function TDlgEncryptDrm.CheckNetPath(sPath: String): String; var sDrive, sExe, sIpAddr: String; dwExecuteTick, dwWaitResult: DWORD; begin Result := sPath; try sDrive := IncludeTrailingPathDelimiter(ExtractFileDrive(sPath)); if not DirectoryExists(sDrive) then begin sIpAddr := ''; if not DcNDrvIps_.ContainsKey(sDrive) then begin // sExe := GetRunExePathDir + DIR_CONF + EXE_HLP; // if FileExists(sExe) then // begin // var O: ISuperObject := SO; // O.I['RcvWnd'] := Handle; // O.I['Cmd'] := HPCMD_REQ_NETDRVADDR; // O.S['NetDrv'] := sDrive; // O.S['OutPath'] := sOutPath_; // // SaveJsonObjToFile(O, sParam_); // {$IFDEF DEBUG} // ExecuteAppWaitUntilTerminate(sExe, '', SW_HIDE); // {$ELSE} // var PI: TProcessInformation := ExecuteAppAsUser('explorer.exe', sExe, '', SW_HIDE); // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 1'); // if PI.hProcess <> 0 then // begin // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 2'); // dwExecuteTick := GetTickCount; // while true do // begin // dwWaitResult := WaitForSingleObject(PI.hProcess, 50); // if dwWaitResult <> WAIT_TIMEOUT then // break; // // if ((GetTickCount - dwExecuteTick) > 5000) then // begin // TerminateProcess(PI.hProcess, 999); // break; // end; // end; // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 3'); // end; // {$ENDIF} // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 4'); // if FileExists(sOutPath_) then // begin // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 5'); // sIpAddr := LoadStrFromFile(sOutPath_, TEncoding.UTF8); //// if sIpAddr <> '' then // 빈값도 넣어줘서 다시 안찾게 함 24_1216 16:22:23 kku // begin // DcNDrvIps_.Add(sDrive, sIpAddr); // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 6, IP=%s', [sIpAddr]); // end; // end; // DeleteFile(sOutPath_); // DeleteFile(sParam_); // end; sIpAddr := NetDriveToRemoteAddr(sDrive); DcNDrvIps_.Add(sDrive, sIpAddr); end else sIpAddr := DcNDrvIps_[sDrive]; if sIpAddr = '' then exit; // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 7, IP=%s', [sIpAddr]); sIpAddr := IncludeTrailingPathDelimiter(sIpAddr); Result := StringReplace(sPath, sDrive, sIpAddr, [rfReplaceAll, rfIgnoreCase]); // TTgTrace.T('TDlgEncryptDrm.AddFile() .. 8, Path=%s', [Result]); end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. CheckNetPath()'); end; end; procedure TDlgEncryptDrm.AddFile(sPath: String); var pData: PDrmEnt; begin try if CheckFList_.IndexOf(sPath) <> -1 then exit; CheckFList_.Add(sPath); pData := VT_AddChildData(vtList); pData.sDir := ExtractFilePath(sPath); pData.sFName := ExtractFileName(sPath); pData.sExt := GetFileExt(pData.sFName).ToUpper; pData.nImgIdx := -1; try pData.bDrm := TTgEncrypt.CheckSign(sPath, SIG_DRM); except pData.bDrm := false; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. AddFile()'); end; end; procedure TDlgEncryptDrm.AddFiles(aList: TStringList); var sPath: String; i: Integer; begin vtList.BeginUpdate; try for i := 0 to aList.Count - 1 do begin sPath := aList[i]; // if not FileExists(sPath) then // continue; AddFile(sPath); end; finally vtList.EndUpdate; end; end; procedure TDlgEncryptDrm.btnAddDirClick(Sender: TObject); procedure ExtrctFilesFromDir(sDir: String); var wfd: TWin32FindData; hSc: THandle; sPath: String; begin sDir := IncludeTrailingPathDelimiter(sDir); sPath := sDir + '*.*'; hSc := FindFirstFile(PChar(sPath), wfd); if hSc = INVALID_HANDLE_VALUE then exit; try Repeat if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then begin ExtrctFilesFromDir(sDir + wfd.cFileName); end else begin AddFile(sDir + wfd.cFileName); end; Until not FindNextFile(hSc, wfd); finally WinApi.Windows.FindClose(hSc); end; end; begin if FileOpenDialog.FileName = '' then FileOpenDialog.DefaultFolder := Format('C:\Users\%s\Desktop', [sUName_]); if FileOpenDialog.Execute then begin ExtrctFilesFromDir(FileOpenDialog.FileName); end; end; procedure TDlgEncryptDrm.btnAddFileClick(Sender: TObject); var i: Integer; begin if (OpenDialog.Files.Count = 0) or (OpenDialog.FileName = '') then OpenDialog.InitialDir := Format('C:\Users\%s\Desktop', [sUName_]); if OpenDialog.Execute(Handle) then begin vtList.BeginUpdate; try for i := 0 to OpenDialog.Files.Count - 1 do AddFile(OpenDialog.Files[i]); finally vtList.EndUpdate; end; end; end; procedure TDlgEncryptDrm.btnEncryptClick(Sender: TObject); var nSuccess, nFail, nEncCnt: Integer; pNode: PVirtualNode; pData: PDrmEnt; enc: TTgDrmEnc; sPath, sDept, sTaskDir, sTgEncPath: String; bResult: Boolean; {$IFDEF _HE_HLP_} O, OA: ISuperObject; {$ENDIF} begin if vtList.RootNodeCount = 0 then begin MessageBox(Handle, PChar(RS_MsgAddFile), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; if CountNorFile = 0 then begin MessageBox(Handle, PChar(RS_NoTgFile), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; sTaskDir := 'C:\ProgramData\HE\EncTask\'; DeleteDir(sTaskDir); if not ForceDirectories(sTaskDir) then begin MessageBox(Handle, PChar(RS_MsgError), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; {$IFDEF _HE_HLP_} OA := TSuperObject.Create(stArray); {$ENDIF} vtList.BeginUpdate; try nSuccess := 0; nFail := 0; nEncCnt := 0; pNode := vtList.GetFirst; while pNode <> nil do begin pData := vtList.GetNodeData(pNode); pNode := vtList.GetNext(pNode); if not pData.bDrm then begin try bResult := false; sPath := pData.sDir + pData.sFName; if TTgEncrypt.CheckSign(sPath, SIG_DRM) then begin pData.bDrm := true; Inc(nEncCnt); continue; end; sTgEncPath := GetSameFileNameInc(sTaskDir + '$Tmpe' + ExtractFileName(sPath)); if MoveFile_wait(sPath, sTgEncPath, 3) then begin SaveStrToFile(sTgEncPath + '.i', sPath, TEncoding.UTF8); enc := TTgDrmEnc.Create(sPath); try enc.SetHaed(PASS_DRM_HEAD, SIG_DRM, sEmpNo_, sUName_, sDept_, sPoName_, CUSTOMER_TYPE); if enc.EncryptFromFile(GetMK, sTgEncPath) then bResult := DeleteFile(sTgEncPath); finally FreeAndNil(enc); end; if bResult then begin DeleteFile(PChar(sTgEncPath + '.i')); Inc(nSuccess); pData.bDrm := true; {$IFDEF _HE_} if gMgSvc.IsNewApi then begin var LogInfo: TLogInfo; ZeroMemory(@LogInfo, SizeOf(LogInfo)); LogInfo.sCode := PREVENT_DRM_ENCRYPT; LogInfo.sPath := sPath; LogInfo.sSummary := ExtractFileName(sPath); gMgSvc.SendEventLogEx(@LogInfo, false); end else gMgSvc.SendEventLog(URI_USER_ACTION, PREVENT_DRM_ENCRYPT, sPath); {$ENDIF} {$IFDEF _HE_HLP_} OA.AsArray.Add(sPath); {$ENDIF} end else begin // 원상복구 MoveFile_wait(sTgEncPath, sPath, 3); DeleteFile(PChar(sTgEncPath + '.i')); Inc(nFail); TTgTrace.T('Fail .. TDlgEncryptDrm.EncFile(), Path=%s', [sPath]); end; end; except Inc(nFail); end; end else Inc(nEncCnt); end; {$IFDEF _HE_HLP_} if OA.AsArray.Length > 0 then begin O := SO; O.B['IsEnc'] := true; O.O['List'] := OA; gParam.SendData(HPCMD_OPEN_ENCRYPT, O.AsJSon); end; {$ENDIF} finally DeleteDir(sTaskDir); vtList.EndUpdate; end; MessageBox(Handle, PChar(Format(RS_CompleteWork1+#13+#10+RS_CompleteWork2, [nSuccess, nFail, nEncCnt])), PChar(Caption), MB_ICONINFORMATION or MB_OK); end; procedure TDlgEncryptDrm.miClearClick(Sender: TObject); begin if MessageBox(Handle, PChar(RS_Q_Clear), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit; CheckFList_.Clear; VT_Clear(vtList); end; procedure TDlgEncryptDrm.miDelFileClick(Sender: TObject); var pNode: PVirtualNode; pData: PDrmEnt; nIdx: Integer; begin pNode := vtList.GetFirstSelected; if pNode = nil then begin MessageBox(Handle, PChar(RS_SelExceptFile), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; if MessageBox(Handle, PChar(RS_Q_ExceptFile), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit; vtList.BeginUpdate; try while pNode <> nil do begin pData := vtList.GetNodeData(pNode); nIdx := CheckFList_.IndexOf(pData.sDir + pData.sFName); if nIdx <> -1 then CheckFList_.Delete(nIdx); pNode := vtList.GetNextSelected(pNode); end; vtList.DeleteSelectedNodes; finally vtList.EndUpdate; end; end; procedure TDlgEncryptDrm.miDelNoDrmClick(Sender: TObject); var pNode, pDNode: PVirtualNode; pData: PDrmEnt; nIdx: Integer; begin pNode := vtList.GetFirst; if pNode = nil then begin MessageBox(Handle, PChar(RS_NoExceptFile), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; vtList.BeginUpdate; try while pNode <> nil do begin pData := vtList.GetNodeData(pNode); if pData.bDrm then begin nIdx := CheckFList_.IndexOf(pData.sDir + pData.sFName); if nIdx <> -1 then CheckFList_.Delete(nIdx); pDNode := pNode; end else pDNode := nil; pNode := vtList.GetNext(pNode); if pDNode <> nil then vtList.DeleteNode(pDNode); end; finally vtList.EndUpdate; end; end; procedure TDlgEncryptDrm.vtListWndProc(var msg: TMessage); procedure ExtrctFilesFromDir(sDir: String); var wfd: TWin32FindData; hSc: THandle; sPath: String; begin sDir := IncludeTrailingPathDelimiter(CheckNetPath(sDir)); sPath := sDir + '*.*'; hSc := FindFirstFile(PChar(sPath), wfd); if hSc = INVALID_HANDLE_VALUE then exit; try Repeat if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then begin ExtrctFilesFromDir(sDir + wfd.cFileName); end else begin AddFile(sDir + wfd.cFileName); end; Until not FindNextFile(hSc, wfd); finally WinApi.Windows.FindClose(hSc); end; end; var sPath: String; nCnt: Integer; i, nLen: Integer; pNode: PVirtualNode; pData: PDrmEnt; begin if msg.Msg = WM_DROPFILES then begin nCnt := DragQueryFile(msg.WParam, DWORD(-1), nil, MAX_PATH); vtList.BeginUpdate; try for i := 0 to nCnt - 1 do begin nLen := DragQueryFile(msg.WParam, i, nil, 0) + 1; SetLength(sPath, nLen); DragQueryFile(msg.WParam, i, PChar(sPath), nLen); sPath := CheckNetPath(DeleteNullTail(sPath)); if FileExists(sPath) then AddFile(sPath) else if DirectoryExists(sPath) then ExtrctFilesFromDir(sPath); end; finally vtList.EndUpdate; end; DragFinish(msg.WParam); exit; end; vtListOldWndProc_(msg); end; procedure TDlgEncryptDrm.vtListAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); var nX, nY, nW, nH: Integer; msg: String; begin if CUSTOMER_TYPE <> CUSTOMER_SERVE1 then // 서브원은 권한때문에 드래그드롭을 못함 24_0711 08:47:40 kku begin if TVirtualStringTree(Sender).RootNodeCount = 0 then begin TargetCanvas.Font.Color := clGray; msg := RS_DrmFileDragDrop; nW := TargetCanvas.TextWidth(msg); nH := TargetCanvas.TextHeight(msg); if Sender.Width > nW then nX := (Sender.Width div 2) - (nW div 2) else nX := 0; if Sender.Height > nH then nY := (Sender.Height div 2) - (nH div 2) - 20 else nY := 0; TargetCanvas.TextOut(nX, nY, msg); end; end; end; procedure TDlgEncryptDrm.vtListContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var pNode: PVirtualNode; begin pNode := vtList.GetNodeAt(MousePos); miDelFile.Visible := pNode <> nil; miClear.Visible := vtList.RootNodeCount > 0; end; procedure TDlgEncryptDrm.vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var pData: PDrmEnt; begin pData := Sender.GetNodeData(Node); Finalize(pData^); end; procedure TDlgEncryptDrm.vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); begin HintText := vtList.Text[Node, Column]; end; procedure TDlgEncryptDrm.vtListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); var pData: PDrmEnt; begin case Kind of ikNormal, ikSelected: begin if Column = 1 then begin pData := Sender.GetNodeData(Node); if pData.nImgIdx = -1 then pData.nImgIdx := GetShellImageIndex_path(pData.sDir + pData.sFName); ImageIndex := pData.nImgIdx; end; end; end; end; procedure TDlgEncryptDrm.vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TDrmEnt); end; procedure TDlgEncryptDrm.vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var pData: PDrmEnt; begin pData := Sender.GetNodeData(Node); case Column of 0 : CellText := IntToStr(Node.Index + 1); 1 : CellText := pData.sFName; 2 : CellText := pData.sExt; 3 : CellText := BooleanToStr(pData.bDrm, 'O', 'X'); 4 : CellText := pData.sDir; end; end; procedure TDlgEncryptDrm.vtListPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var pData: PDrmEnt; begin if not (vsSelected in Node.States) then begin pData := Sender.GetNodeData(Node); if pData.bDrm then TargetCanvas.Font.Color := clGreen; end; end; end.