{ *------------------------------------------------------------------------------
  Header file for usage of the  Eraser library for file shredding

  @Author Patrick Michael Kolla
  @Version 0.2
  ------------------------------------------------------------------------------- }
// *****************************************************************************
// Copyright: Eraser © 2002-02008 Heidi computers Limited
// Copyright: Eraser © 1997-02002 Sami Tolvanen
// Copyright: Comments © Heidi Computers Limited
// License:   Unsure still, see links
// File:      snlAPIEraser.pas
// Compiler:  Delphi, FreePascal
// Purpose:   Header file for usage of the  Eraser library for file shredding
// Authors:   Patrick M. Kolla (pk) @ Safer Networking Limited
// *****************************************************************************
// Product site: http://www.heidi.ie/eraser/default.php
// Sourceforge site: http://sourceforge.net/projects/eraser/
// License addition: http://www.heidi.ie/eraser/source.php
// Example implementation: http://www.autoitscript.com/forum/index.php?showtopic=73930
// *****************************************************************************
// Dependencies:
// eraser.dll (to be able to erase something)
// *****************************************************************************
// Changelog (new entries first):
// ---------------------------------------
// 2008-06-04  pk  10m  Added 5.8.6 names (_name@number ugly C style)
// 2007-07-24  pk  30m  Written with the help of official example
// *****************************************************************************

unit snlAPIEraser;

interface

uses
   Windows;

const
   diskClusterTips             = 64;
   diskDirEntries              = 128;
   diskFreeSpace               = 32;
   ERASER_ERROR                = -1;
   ERASER_ERROR_CONTEXT        = -11;
   ERASER_ERROR_DENIED         = -15;
   ERASER_ERROR_EXCEPTION      = -10;
   ERASER_ERROR_INIT           = -12;
   ERASER_ERROR_MEMORY         = -8;
   ERASER_ERROR_NOTIMPLEMENTED = -32;
   ERASER_ERROR_NOTRUNNING     = -14;
   ERASER_ERROR_PARAM1         = -2;
   ERASER_ERROR_PARAM2         = -3;
   ERASER_ERROR_PARAM3         = -4;
   ERASER_ERROR_PARAM4         = -5;
   ERASER_ERROR_PARAM5         = -6;
   ERASER_ERROR_PARAM6         = -7;
   ERASER_ERROR_RUNNING        = -13;
   ERASER_ERROR_THREAD         = -9;
   ERASER_OK                   = 0;
   ERASER_REMOVE_FOLDERONLY    = 0;
   ERASER_REMOVE_RECURSIVELY   = 1;
   ERASER_TEST_PAUSED          = 3;
   ERASER_WIPE_BEGIN           = 0;
   ERASER_WIPE_DONE            = 2;
   ERASER_WIPE_UPDATE          = 1;
   eraserDispInit              = 64;
   eraserDispItem              = 32;
   eraserDispMessage           = 4;
   eraserDispPass              = 1;
   eraserDispProgress          = 8;
   eraserDispReserved          = 128;
   eraserDispStop              = 16;
   eraserDispTime              = 2;
   fileAlternateStreams        = 4;
   fileClusterTips             = 1;
   fileNames                   = 2;

type
   ERASER_DATA_TYPE    = (ERASER_DATA_DRIVES, ERASER_DATA_FILES);
   ERASER_METHOD       = (ERASER_METHOD_LIBRARY, ERASER_METHOD_GUTMANN, ERASER_METHOD_DOD, ERASER_METHOD_PSEUDORANDOM);
   ERASER_OPTIONS_PAGE = (ERASER_PAGE_DRIVE, ERASER_PAGE_FILES);

   // Library initialization
   TFunceraserInit = function: integer; stdcall;
   /// initializes the library, must be called before using
   TFunceraserEnd = function: integer; stdcall;
   /// cleans up after use
   // Context creation and destruction
   TFunceraserCreateContext   = function(var Context: integer): integer; stdcall; // creates context with predefined settings
   TFunceraserCreateContextEx = function(var Context: integer; Method: integer; Passes: integer; Items: Byte): integer; stdcall; // creates context and sets an alternative method, pass count and items to erase
   TFunceraserDestroyContext  = function(Context: integer): integer; stdcall; // destroys a context
   TFunceraserIsValidContext  = function(Context: integer): integer; stdcall; // checks the validity of a context, return ERASER_OK if valid
   // Data type
   TFunceraserSetDataType = function(Context: integer; DataType: ERASER_DATA_TYPE): integer; stdcall; // sets context data type
   TFunceraserGetDataType = function(Context: integer; var DataType: ERASER_DATA_TYPE): integer; stdcall; // returns context data type
   // Data
   TFunceraserAddItem    = function(Context: integer; const FileName: pchar; const NameLength: integer): integer; stdcall; // adds item to the context data array
   TFunceraserClearItems = function(Context: integer): integer; stdcall; // clears the context data array
   // Notification
   TFunceraserSetWindow        = function(var Context: integer; xHwnd: integer): integer; stdcall; // sets the window to notify
   TFunceraserGetWindow        = function(var Context: integer; xHwnd: integer): integer; stdcall; // returns the window
   TFunceraserSetWindowMessage = function(var Context: integer; message: integer): integer; stdcall; // sets the window message
   TFunceraserGetWindowMessage = function(var Context: integer; message: integer): integer; stdcall; // returns the window message
   // Statistics
   TFunceraserStatGetArea  = function(Context: integer; var Bytes: Longint): integer; stdcall; // returns the erased area
   TFunceraserStatGetTips  = function(Context: integer; var Bytes: Longint): integer; stdcall; // returns the erased cluster tip area
   TFunceraserStatGetWiped = function(Context: integer; var Bytes: Longint): integer; stdcall; // returns the amount of data written
   TFunceraserStatGetTime  = function(Context: integer; MilliSeconds: integer): integer; stdcall; // returns the time used  = function(ms)
   // Display
   TFunceraserDispFlags = function(var Context: integer; Flags: Byte): integer; stdcall; // returns what the UI should show  = function(see above for flag descriptions)
   // Progress information
   TFunceraserProgGetTimeLeft         = function(var Context: integer; Seconds: integer): integer; stdcall; // returns an estimate of how integer the operation takes to complete
   TFunceraserProgGetPercent          = function(var Context: integer; Percent: Byte): integer; stdcall; // returns the completion percent of current item
   TFunceraserProgGetTotalPercent     = function(var Context: integer; Percent: Byte): integer; stdcall; // returns the completion percent of the operation
   TFunceraserProgGetCurrentPass      = function(var Context: integer; Pass: integer): integer; stdcall; // returns the index of the current overwriting pass
   TFunceraserProgGetPasses           = function(var Context: integer; Passes: integer): integer; stdcall; // returns the amount of passes
   TFunceraserProgGetMessage          = function(var Context: integer; message: pchar; Length: integer): integer; stdcall; // returns a message UI can to show to the user telling what is going on
   TFunceraserProgGetCurrentDataPchar = function(var Context: integer; Data: pchar; Length: integer): integer; stdcall; // returns the name of the item that is being processed
   // Control
   TFunceraserStart     = function(Context: integer): integer; stdcall; // starts overwriting in a new thread
   TFunceraserStartSync = function(Context: integer): integer; stdcall; // starts overwriting
   TFunceraserStop      = function(Context: integer): integer; stdcall; // stops running task
   TFunceraserIsRunning = function(var Context: integer; Running: Byte): integer; stdcall; // checks whether task is being processed
   // Result
   TFunceraserCompleted       = function(var Context: integer; Completed: Byte): integer; stdcall; // checks whether the task was completed successfully
   TFunceraserFailed          = function(var Context: integer; Failed: Byte): integer; stdcall; // checks whether the task failed
   TFunceraserTerminated      = function(var Context: integer; Terminated: Byte): integer; stdcall; // checks whether the task was terminated
   TFunceraserErrorPcharCount = function(var Context: integer; Count: integer): integer; stdcall; // returns the amount of error messages in the context array
   TFunceraserErrorPchar      = function(var Context: integer; index: integer; Error: pchar; Length: integer): integer; stdcall; // retrieves the given error message from the array
   TFunceraserFailedCount     = function(var Context: integer; Count: integer): integer; stdcall; // returns the amount of failed items in the context array
   TFunceraserFailedPchar     = function(var Context: integer; index: integer; Error: pchar; Length: integer): integer; stdcall; // retrieves the given failed item from the array
   // Display report
   TFunceraserShowReport = function(Context: integer; const xHwnd: Hwnd): integer; stdcall; // displays erasing report
   // Display library options
   TFunceraserShowOptions = function(xHwnd: integer; OptionsPage: integer): integer; stdcall; // displays the options window
   // File / directory deletion
   TFunceraserRemoveFile   = function(FileName: pchar; NameLength: integer): integer; stdcall; // removes a file
   TFunceraserRemoveFolder = function(FolderName: pchar; NameLength: integer; RemoveType: Byte): integer; stdcall; // removes a folder
   // Helpers
   TFunceraserGetFreeDiskSpace = function(Drive: pchar; NameLength: integer; FreeBytes: integer): integer; stdcall; // returns the amount of free disk space on a drive
   TFunceraserGetClusterSize   = function(Drive: pchar; NameLength: integer; ClusterSize: integer): integer; stdcall; // returns the cluster size of a partition
   // Test mode
   TFunceraserTestEnable          = function(var Context: integer): integer; stdcall; // enables test mode --> files will be opened with sharing enabled and erasing process will be paused after each overwriting pass until eraserTestContinueProcess = function(...) is called for the handle
   TFunceraserTestContinueProcess = function(var Context: integer): integer; stdcall; // continues paused erasing process in test mode

   // From here on, comments below are JavaDoc compatible, written by pk

   { TEraser }

   TEraser = class
   private
      FDLLHandle: THandle;
      /// Handle to library
      FIsAvailable: boolean;
      /// Stores availability status
      FFunceraserInit: TFunceraserInit;
      /// API function link
      FFunceraserEnd: TFunceraserEnd;
      /// API function link
      FFunceraserRemoveFile: TFunceraserRemoveFile;
      /// API function link
      FFunceraserRemoveFolder: TFunceraserRemoveFolder;
      /// API function link
      function LoadLibrary: boolean;
      /// Called by constructor
      procedure FreeLibrary;
      /// Called by destructor
   public
      constructor Create;
      /// Constructor, automatically links if possible
      destructor Destroy; override;
      /// Destructor, automatically unlinks
      function IsAvailable: boolean;
      /// Returns availability
      function EraserInit: boolean;
      /// API call: initialization
      function EraserEnd: boolean;
      /// API call: finalization
      function EraserRemoveFile(const FileName: string): boolean;
   end;

implementation

{ *------------------------------------------------------------------------------
  Returns whether a return constitutes a successful operation.

  @param ReturnValue  Value to check
  @return Returns true if value is an error code.
  ------------------------------------------------------------------------------* }
function eraserOK(const ReturnValue: integer): boolean; inline;
begin
   eraserOK := (ReturnValue >= ERASER_OK);
end;

{ *------------------------------------------------------------------------------
  Returns whether a return constitutes an error.

  @param ReturnValue  Value to check
  @return Returns true if value is an error code.
  ------------------------------------------------------------------------------* }
function eraserError(const ReturnValue: integer): boolean; inline;
begin
   eraserError := (ReturnValue < ERASER_OK);
end;

{ TEraser }

{ *------------------------------------------------------------------------------
  Standard constructor, tries to connect to the library.
  ------------------------------------------------------------------------------* }
constructor TEraser.Create;
begin
   FDLLHandle := 0;
   FIsAvailable := false;
   LoadLibrary;
end;

{ *------------------------------------------------------------------------------
  Standard destructor, disconnects from the library if connected.
  ------------------------------------------------------------------------------* }
destructor TEraser.Destroy;
begin
   FreeLibrary;
   inherited;
end;

{ *------------------------------------------------------------------------------
  Tests whether the Eraser library is available, and if so, de-initializes it.

  @return Non-Availability status.
  ------------------------------------------------------------------------------* }
function TEraser.EraserEnd: boolean;
var
   iReturnCode: integer;
begin
   if FIsAvailable and Assigned(FFunceraserEnd) then begin
      iReturnCode := FFunceraserEnd;
      Result := eraserOK(iReturnCode);
   end else begin
      Result := false;
   end;
end;

{ *------------------------------------------------------------------------------
  Tests whether the Eraser library is available, and if so, initializes it.

  @return Availability status.
  ------------------------------------------------------------------------------* }
function TEraser.EraserInit: boolean;
var
   iReturnCode: integer;
begin
   if FIsAvailable and Assigned(FFunceraserInit) then begin
      iReturnCode := FFunceraserInit;
      Result := eraserOK(iReturnCode);
   end else begin
      Result := false;
   end;
end;

{ *------------------------------------------------------------------------------
  Uses the Eraser library to remove a file.

  @return Success status.
  ------------------------------------------------------------------------------* }
function TEraser.EraserRemoveFile(const FileName: string): boolean;
var
   iReturnCode, dwLen: integer;
begin
   if FIsAvailable then begin
      dwLen := Length(FileName) + 1;
      iReturnCode := FFunceraserRemoveFile(pchar(FileName), dwLen);
      Result := eraserOK(iReturnCode);
   end else begin
      Result := false;
   end;
end;

{ *------------------------------------------------------------------------------
  Unlinks from library, if loaded.
  ------------------------------------------------------------------------------* }
procedure TEraser.FreeLibrary;
begin
   if FDLLHandle > 0 then begin
      Windows.FreeLibrary(FDLLHandle);
      FDLLHandle := 0;
      FIsAvailable := false;
   end;
end;

{ *------------------------------------------------------------------------------
  Tests whether the Eraser library is available and linked for usage.

  @return Availability status.
  ------------------------------------------------------------------------------* }
function TEraser.IsAvailable: boolean;
begin
   Result := (FDLLHandle > 0) and FIsAvailable;
end;

{ *------------------------------------------------------------------------------
  Loads the Eraser library and dynamically links some functions

  @return Success status.
  ------------------------------------------------------------------------------* }
function TEraser.LoadLibrary: boolean;
begin
   FDLLHandle := Windows.LoadLibrary('eraser.dll'); // up to 5.8.8, 6.x uses different DLLs
   if FDLLHandle > 0 then
      try
         FFunceraserInit := GetProcAddress(FDLLHandle, 'eraserInit');
         if not Assigned(FFunceraserInit) then begin
            FFunceraserInit := GetProcAddress(FDLLHandle, '_eraserInit@0');
         end;

         FFunceraserEnd := GetProcAddress(FDLLHandle, 'eraserEnd');
         if not Assigned(FFunceraserEnd) then begin
            FFunceraserEnd := GetProcAddress(FDLLHandle, '_eraserEnd@0');
         end;

         FFunceraserRemoveFile := GetProcAddress(FDLLHandle, 'eraserRemoveFile');
         if not Assigned(FFunceraserRemoveFile) then begin
            FFunceraserRemoveFile := GetProcAddress(FDLLHandle, '_eraserRemoveFile@8');
         end;

         FFunceraserRemoveFolder := GetProcAddress(FDLLHandle, 'eraserRemoveFolder');
         if not Assigned(FFunceraserRemoveFolder) then begin
            FFunceraserRemoveFolder := GetProcAddress(FDLLHandle, '_eraserRemoveFolder@12');
         end;

         FIsAvailable := Assigned(FFunceraserInit) and Assigned(FFunceraserEnd) and Assigned(FFunceraserRemoveFile) and Assigned(FFunceraserRemoveFolder);
      except
         FIsAvailable := false;
      end;
   Result := FIsAvailable;
end;

initialization

finalization

end.

