fmtmain.pas

Delphi Hard Disk - Check Disk and Format Disk Components.

unit fmtmain;

// Test program for Magenta Check Disk and Format Disk component
// 20th October 2005 - Release 1.0 (C) Magenta Systems Ltd, 2005

// Copyright by Angus Robertson, Magenta Systems Ltd, England
// [e-mail], http://www.magsys.co.uk/delphi/

interface

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

type
  TMainForm = class(TForm)
    Log: TMemo;
    Panel1: TPanel;
    doChkDsk: TButton;
    doExit: TButton;
    DriveBox: TDriveComboBox;
    OptCorrectErrors: TCheckBox;
    OptVerbose: TCheckBox;
    OptCheckDirty: TCheckBox;
    OptScanDrive: TCheckBox;
    OptQuickFmt: TCheckBox;
    doAbort: TButton;
    doFrmtDsk: TButton;
    ProgressBar: TProgressBar;
    FileSystem: TComboBox;
    Label1: TLabel;
    VolumeLabel: TEdit;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure doChkDskClick(Sender: TObject);
    procedure doExitClick(Sender: TObject);
    procedure doAbortClick(Sender: TObject);
    procedure doFrmtDskClick(Sender: TObject);
  private
    { Private declarations }
    procedure LogInfo (Info: String) ;
    procedure ProgressEvent (Percent: integer; var Cancel: boolean) ;
    procedure InfoEvent (Info: string; var Cancel: boolean) ;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  MagFmtChkDsk: TMagFmtChkDsk ;
  CancelFlag: boolean ;

implementation

{$R *.dfm}

procedure TMainForm.FormDestroy(Sender: TObject);
begin
    FreeAndNil (MagFmtChkDsk) ;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    MagFmtChkDsk := TMagFmtChkDsk.Create (self) ;
    MagFmtChkDsk.onProgressEvent := ProgressEvent ;
    MagFmtChkDsk.onInfoEvent := InfoEvent ;
end;

procedure TMainForm.LogInfo (Info: String) ;
begin
    Log.Lines.Add (Info) ;
end ;

procedure TMainForm.ProgressEvent (Percent: integer; var Cancel: boolean) ;
begin
//    LogInfo ('Percent Completed: ' + IntToStr (Percent)) ;
    ProgressBar.Position := Percent ;
    Application.ProcessMessages ;
    Cancel := CancelFlag ;
end ;

procedure TMainForm.InfoEvent (Info: string; var Cancel: boolean) ;
begin
    LogInfo (Info) ;
    Application.ProcessMessages ;
    Cancel := CancelFlag ;
end ;

procedure TMainForm.doChkDskClick(Sender: TObject);
begin
    CancelFlag := false ;
    doChkDsk.Enabled := false ;
    doFrmtDsk.Enabled := false ;
    try
        try
            ProgressBar.Position := 0 ;
            LogInfo ('Starting Check Disk for ' + Uppercase (DriveBox.Drive) + ':') ;
            if NOT MagFmtChkDsk.CheckDisk (DriveBox.Drive + ':\', OptCorrectErrors.Checked,
                 OptVerbose.Checked, OptCheckDirty.Checked, OptScanDrive.Checked) then
                LogInfo ('Check Disk Failed') ;
            ProgressBar.Position := 0 ;
            if MagFmtChkDsk.FileSysProblem then
                 LogInfo ('!!! Check Disk Found Problems with ' + Uppercase (DriveBox.Drive) + ':') ;
        except
            on E:Exception do LogInfo ('Error: ' + E.Message) ;
        end ;
    finally
        doChkDsk.Enabled := true ;
        doFrmtDsk.Enabled := true ;
        LogInfo ('') ;
    end ;
end;

procedure TMainForm.doFrmtDskClick(Sender: TObject);
var
    MediaType: TMediaType;
begin
    if Trim (VolumeLabel.Text) = '' then
    begin
        LogInfo ('Must Specify a Volume Label To Format a Drive') ;
        exit ;
    end ;
    CancelFlag := false ;
    doChkDsk.Enabled := false ;
    doFrmtDsk.Enabled := false ;
    MediaType := mtHardDisk ;
    if UpperCase (DriveBox.Drive) < 'C' then MediaType := mtFloppy ;
    try
        try
            ProgressBar.Position := 0 ;
            LogInfo ('Starting Format Disk for ' + Uppercase (DriveBox.Drive) + ':') ;
            if NOT MagFmtChkDsk.FormatDisk (DriveBox.Drive + ':\', MediaType,
                   TFileSystem (FileSystem.ItemIndex), Trim (VolumeLabel.Text),
                                                        OptQuickFmt.Checked, 0) then
                LogInfo ('Format Disk Failed') ;
            ProgressBar.Position := 0 ;
        except
            on E:Exception do LogInfo ('Error: ' + E.Message) ;
        end ;
    finally
        doChkDsk.Enabled := true ;
        doFrmtDsk.Enabled := true ;
        LogInfo ('') ;
    end ;
end;

procedure TMainForm.doExitClick(Sender: TObject);
begin
    CancelFlag := true ;
    Close ;
end;

procedure TMainForm.doAbortClick(Sender: TObject);
begin
    CancelFlag := true ;
end;


end.