{*------------------------------------------------------------------------------
  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
//            Eraser © 1997-02002 Sami Tolvanen
//            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
// *****************************************************************************
// 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');
   if FDLLHandle>0 then try
      FFunceraserInit := GetProcAddress(FDLLHandle, 'eraserInit');
      if not Assigned(FFunceraserInit)
       then FFunceraserInit := GetProcAddress(FDLLHandle, '_eraserInit@0');

      FFunceraserEnd := GetProcAddress(FDLLHandle, 'eraserEnd');
      if not Assigned(FFunceraserEnd)
       then FFunceraserEnd := GetProcAddress(FDLLHandle, '_eraserEnd@0');

      FFunceraserRemoveFile := GetProcAddress(FDLLHandle, 'eraserRemoveFile');
      if not Assigned(FFunceraserRemoveFile)
       then FFunceraserRemoveFile := GetProcAddress(FDLLHandle, '_eraserRemoveFile@8');

      FFunceraserRemoveFolder := GetProcAddress(FDLLHandle, 'eraserRemoveFolder');
      if not Assigned(FFunceraserRemoveFolder)
       then FFunceraserRemoveFolder := GetProcAddress(FDLLHandle, '_eraserRemoveFolder@12');
       
      FIsAvailable := Assigned(FFunceraserInit) and Assigned(FFunceraserEnd)
       and Assigned(FFunceraserRemoveFile) and Assigned(FFunceraserRemoveFolder);
   except
      FIsAvailable := false;
   end;
   Result := FIsAvailable;
end;

initialization
finalization
end.
