filename _expmac_ catalog 'sasuser.explorer.safe_delete.source' ;

data _null_;
* file xactions(safe_delete.source) lrecl=160;
  file _expmac_;
  input;
  put _infile_;
datalines4;

%macro safe_delete
( lib, mem, memtype ) / des='Safe Delete';

  /*
   * Title:   SAS Explorer Action - Safe delete
   * Purpose: Delete SAS member to recycle bin
   * Author:  Richard A. DeVenezia
   * Date:    07mar05
   * Notes:   Windows only.
   *          Only tested for single and concatenated local path librefs
   *          No tests performed for cases of REMOTE librefs
   *          or SAS/Access librefs such as ORACLE, ODBC, etc..
   *
   * The two forms of lib tested are
   * - Single path name: Path does not start with (
   * - Multiple path names: List of names starts with (
   */

  %local path msg command;

  %let path = %sysfunc(pathname(&lib));

  %if %qsubstr(&path,1,1) = %str(%() %then %do;

    %let msg =
NOTE: Safe deletion of members in concatenated libraries is not supported.;

    %put &msg;

    POSTMESSAGE "&msg";

  %end;
  %else
  %if %length (&path) %then %do;

    gsub '%safe_delete_dispatch';

    &command;

  %end;

%mend;

%macro safe_delete_dispatch;

  /*
   * Purpose: Search the paths of a concatenated libref for a member
   * Title:   SAS Explorer Action - Safe delete, auxiliary handler
   * Author:  Richard A. DeVenezia
   * Date:    07mar05
   *
   * Two macro variables are presumed to exist in callers scope
   * - path, a parenthesis bounded list of quote or
   *         dquote delimited items
   * - mem, member to search for
   */

  %local fid opt1 device fpath sep ;

  %let fid = %sysfunc (FOPEN(SASCBTBL));
  %if &fid %then %do;
    %let opt1 = %sysfunc (FOPTNAME(&fid,1));
    %if %scan(%upcase(&opt1),1) = CATALOG %then
      %let device = CATALOG;

    %let fid = %sysfunc(FCLOSE(&fid));
  %end;

  %let fpath = %sysfunc (PATHNAME(SASCBTBL));

  %if %qsubstr(&path,1,1) ne %str(%() %then
    %let fpath = %sysfunc (quote(&fpath));

* options mprint;

  filename SASCBTBL catalog
    "SASUSER.EXPLORER.SAFE_DELETE_ROUTINE.SOURCE";

  %let mem = %sysfunc(lowcase(&mem));

  %if &SYSSCP = WIN %then %let sep = \; %else %let sep = /;

  %let command = REFRESH;

  data _null_;
    FO_DELETE     = 03x;
    FOF_ALLOWUNDO = 40x;

    cancelled = 0;

    length filenames $5000;

  %if %upcase(&memtype) = TABLE %then %do;

    ds = open ("&lib..&mem");
    if ds then do;
      rc = attrn (ds, 'ICONST');
      ds = close (ds);
    end;

    if rc in (2,3) then do;
      command = "POSTMESSAGE '&lib..&mem can not be deleted, "
             || "it is bound by referential integrity constraints.';" ;

      call symput ('command', trim(command));
      stop;
    end;

    file1 = "&path.&sep.&mem..sas7bdat";
    file2 = "&path.&sep.&mem..sas7bndx";

    if fileExist (file1) then
      filenames = trim(file1)||"00"x;

    if fileExist (file2) then
       filenames = trim(filenames) || trim(file2) || "00"x;

    filenames = trim(left(filenames)) || "00"x;

    %end;

  %if %upcase(&memtype) = VIEW %then %do;

    file1 = "&path.&sep.&mem..sas7bvew";

    if fileExist (file1) then
      filenames = trim(file1)||"00"x;

    filenames = trim(left(filenames)) || "00"x;

  %end;

  %if %upcase(&memtype) = CATALOG %then %do;

    file1 = "&path.&sep.&mem..sas7bcat";

    if fileExist (file1) then
      filenames = trim(file1)||"00"x;

    filenames = trim(left(filenames)) || "00"x;

  %end;

    title = "SAS Safe Delete" || "00"x;

    if filenames ne "0000"x then do;
    rc = modulen ( "SHFileOperationA"
                 , 0
                 , FO_DELETE
                 , addr(filenames)
                 , 0, FOF_ALLOWUNDO, cancelled, 0, addr(title));

*   put rc= cancelled=;
    end;

  run;

  %if %length(&fpath) %then %do;
    filename SASCBTBL &device &fpath;
  %end;

%mend;
;;;;
run;

filename _expmac_ catalog 'sasuser.explorer.safe_delete_routine.source' ;

data _null_;
* file xactions(safe_delete_routine.source) lrecl=160;
  file _expmac_;
  input;
  put _infile_;
datalines4;
routine SHFileOperationA
  module=SHELL32
  minarg=8
  maxarg=8
  stackpop=called
  returns=long
;

* SHFILEOPTSTRUCT;
arg 1 fdstart
      num  input  format=pib4. ; * HWND         hwnd;
arg 2 num  input  format=pib4. ; * UINT         wFunc;
arg 3 num  input  format=pib4. ; * LPCSTR       pFrom double null terminated;
arg 4 num  input  format=pib4. ; * LPCSTR       pTo;
arg 5 num  input  format=pib4. ; * FILEOP_FLAGS fFlags;
arg 6 num  update format=pib4. ; * BOOL         fAnyOperationsAborted;
arg 7 num  input  format=pib4. ; * LPVOID       hNameMappings;
arg 8 num  input  format=pib4. ; * LPCSTR       lpszProgressTitle;
;;;;
run;

filename _expmac_ clear;

%include xactions (safe_delete.source);