Delphi file disk

This is a Delphi code sample to demonstrate how to create and format file disk using native DLL.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Mount: TButton;
    Format: TButton;
    ProgressBar1: TProgressBar;
    Unmount: TButton;
    StartDriverButton: TButton;
    StopDriverButton: TButton;
    procedure MountClick(Sender: TObject);
    procedure OnClose(Sender: TObject; var Action: TCloseAction);
    procedure OnShow(Sender: TObject);
    procedure FormatClick(Sender: TObject);
    procedure UnmountClick(Sender: TObject);
    procedure StartDriverButtonClick(Sender: TObject);
    procedure StopDriverButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DriveHandle : Integer;
  DriveMemory : pointer;
  hFile : THandle;

implementation

{$R *.dfm}


// ----------------------------------
// VDSDK functions declarations
// ----------------------------------
function InitializeVDSDK() : boolean; stdcall external 'VDSDKDll.dll';
function ShutdownVDSDK(bForceUnmountDisks : boolean) : boolean; stdcall external 'VDSDKDll.dll';
function CreateVirtualDrive(DriveLetter : char; DriveSize : Integer;
  pReadCallback, pWriteCallback : pointer) : Integer; stdcall external 'VDSDKDll.dll';

function CreateVirtualDriveEx(DriveLetter : char; DriveSize : Integer;
  pReadCallback, pWriteCallback : pointer; bReadOnly : boolean; DriveFlags : LongWord) : Integer; stdcall external 'VDSDKDll.dll';

function FormatVirtualDrive(h : Integer; bQuickFormat : boolean; FileSystem : PChar; VolumeLabel : PChar;
  pCallbackHandler : pointer) : boolean; stdcall external 'VDSDKDll.dll';
function DestroyVirtualDrive(h : Integer; bForce : boolean) : boolean; stdcall external 'VDSDKDll.dll';
function GetVDSDKErrorCode() : Integer; stdcall external 'VDSDKDll.dll';
function InstallDriver() : boolean; stdcall external 'VDSDKDll.dll';
function StartDriver() : boolean; stdcall external 'VDSDKDll.dll';
function StopDriver() : boolean; stdcall external 'VDSDKDll.dll';
function UninstallDriver() : boolean; stdcall external 'VDSDKDll.dll';
function IsDriverReady() : boolean; stdcall external 'VDSDKDll.dll';
function GetVDSDKDriverVersion(major, minor : PInteger) : boolean; stdcall external 'VDSDKDll.dll';
function ActivateVDSDK(ActivationKey : PChar) : boolean; stdcall external 'VDSDKDll.dll';



// ----------------------------------
// callback handlers
// ----------------------------------
function OnRead(h : Integer; ReadOffset : Int64; ReadSize : Cardinal;
  var ReadBuffer; var BytesRead : dword) : boolean stdcall;
  var Offset : LARGE_INTEGER;
begin
  Offset.QuadPart := ReadOffset;
  SetFilePointer(hFile,Offset.LowPart,@Offset.HighPart,FILE_BEGIN);
  ReadFile(hFile,ReadBuffer, ReadSize, BytesRead, nil);
  OnRead := true;
end;

function OnWrite(h : Integer; WriteOffset : Int64; WriteSize : Cardinal;
  var WriteBuffer; var BytesWritten : dword) : boolean stdcall;
  var Offset : LARGE_INTEGER;
begin
  Offset.QuadPart := WriteOffset;
  SetFilePointer(hFile,Offset.LowPart,@Offset.HighPart,FILE_BEGIN);
  WriteFile(hFile,WriteBuffer, WriteSize, BytesWritten, nil);
  OnWrite := true;
end;


function OnFormat(Progress : dword) : boolean stdcall;
begin
  Form1.ProgressBar1.Min := 0;
  Form1.ProgressBar1.Max := 100;
  Form1.ProgressBar1.Position := Progress;
  OnFormat := true;
end;

// mount
procedure TForm1.MountClick(Sender: TObject);
begin
  DriveHandle := CreateVirtualDriveEx('Z',256,@OnRead, @OnWrite,false,0);

  if DriveHandle <> -1 then
  begin
    MessageBox(Form1.WindowHandle,'Success','Message',0);
  end
  else
  begin
    MessageBox(Form1.WindowHandle,'Error','Message',0);
  end;

end;

// format
procedure TForm1.FormatClick(Sender: TObject);
var result : boolean;
begin
  if DriveHandle <> -1 then
  begin
    result := FormatVirtualDrive(DriveHandle,false,'NTFS','VDSDK',@OnFormat);

    if result = true then
    begin
      MessageBox(Form1.WindowHandle,'Success','Message',0);
    end
    else
    begin
          MessageBox(Form1.WindowHandle,'Error','Message',0);
    end;
  end;
end;

// unmount
procedure TForm1.UnmountClick(Sender: TObject);
var result : boolean;
begin
  if DriveHandle <> -1 then
  begin
    result := DestroyVirtualDrive(DriveHandle,false);

    if result = true then
    begin
      DriveHandle := -1;
      MessageBox(Form1.WindowHandle,'Success','Message',0);
    end
    else
    begin
          MessageBox(Form1.WindowHandle,'Error','Message',0);
    end;

  end;

end;

// on close
procedure TForm1.OnClose(Sender: TObject; var Action: TCloseAction);
begin
  if DriveHandle <> -1 then
  begin
    DestroyVirtualDrive(DriveHandle,true);
    DriveHandle := -1;
  end;

  // shutdown VDSDK
  ShutdownVDSDK(true);

  // close file handle
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(hFile);
  end;
end;

// initialization
procedure TForm1.OnShow(Sender: TObject);
begin
  // Initialize VDSDK
  InitializeVDSDK();

  // create/open file
  hFile := CreateFile(PChar('disk.dat'), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil,
    OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING or FILE_FLAG_RANDOM_ACCESS, 0);

  DriveHandle := -1;
  ActivateVDSDK('Activation key');
end;




procedure TForm1.StartDriverButtonClick(Sender: TObject);
var result : boolean;
begin
  InstallDriver();
  StartDriver();
  InitializeVDSDK();
  result := IsDriverReady();

  if result = true then
    begin
      MessageBox(Form1.WindowHandle,'Success','Message',0);
    end
    else
    begin
          MessageBox(Form1.WindowHandle,'Error','Message',0);
    end;
end;

procedure TForm1.StopDriverButtonClick(Sender: TObject);
begin
  ShutdownVDSDK(true);
  StopDriver();
  UninstallDriver();
end;

end.