Solved

copy files form c:\ to drive a:\   with complete exception handling

Posted on 2003-10-23
1
254 Views
Last Modified: 2010-04-05
Hi,
    Can you please help me. i am trying to make a program that copys a file
    or multiple files using the filelist box in drive a with a multiple select
   enabled with a complete exeception handling.. thanks.
0
Comment
Question by:vbeginner
1 Comment
 
LVL 17

Accepted Solution

by:
geobul earned 250 total points
ID: 9612891
Hi,

Try this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    flb: TFileListBox;
    btnCopy: TButton;
    procedure btnCopyClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const Dest = 'a:\';

function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: word;
begin
  Drive := UpCase(Drive);
  if not (Drive in ['A'..'Z']) then
    raise EConvertError.Create('Not a valid drive ID');
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    if DiskSize(Ord(Drive) - $40) = -1 then
      DiskInDrive := False
    else
      DiskInDrive := True;
  finally
    SetErrorMode(ErrorMode);
  end;
end;

function CopyAFile(const fname, FromFolder, ToFolder: string): boolean;
var
  res: integer;
  newname: string;
begin
  result := true;
  try
    if FileExists(ToFolder + fname) then begin
      res := windows.MessageBox(0, PChar('File '+fname+' exists. Overwrite?'), PChar('Question'), MB_YESNOCANCEL or MB_ICONQUESTION);
      if res = IDYES then begin // overrite
        try
          if not CopyFile(PChar(FromFolder + fname), PChar(ToFolder + fname), false) then begin
            windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
            result := false;
            exit;
          end;
        except
          windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
          result := false;
          exit;
        end;
      end;
      if res = IDNO then begin // ask for rename
        repeat
          newname := InputBox('Rename '+fname, 'Enter new name:',fname);
          if FileExists(ToFolder + newname) then begin
            if windows.MessageBox(0, PChar('File '+fname+' exists. Enter new name?'), PChar('Question'), MB_YESNO or MB_ICONQUESTION) = IDNO then begin
              ShowMessage('File '+fname+' wan''t coppied');
              exit;
            end;
          end;
        until true;
        try
          if not CopyFile(PChar(FromFolder + fname), PChar(ToFolder + newname), false) then begin
            windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
            result := false;
            exit;
          end;
        except
          windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
          result := false;
          exit;
        end;
      end;
      if res = IDCANCEL then begin // copy cancelled
        ShowMessage('File '+fname+' wan''t coppied');
        exit;
      end;
    end else begin // normal copy
      try
        if not CopyFile(PChar(FromFolder + fname), PChar(ToFolder + fname), false) then begin
          windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
          result := false;
          exit;
        end;
      except
        windows.MessageBox(0, PChar('Error copying file '+fname), PChar('Error'), MB_OK or MB_ICONERROR);
        result := false;
        exit;
      end;
    end;
  except
    result := false;
  end;
end;

procedure TForm1.btnCopyClick(Sender: TObject);
var
  i: integer;
begin
  with flb do begin
    if SelCount > 0 then begin
      if DiskInDrive('a') then begin
        for i := 0 to Items.Count - 1 do begin
          if Selected[i] then begin
            if not CopyAFile(flb.Items[i], flb.Directory + '\', Dest) then begin
              ShowMessage('Copy failed !');
              exit;
            end;
          end;
        end;
        ShowMessage('Done');
      end else begin
        ShowMessage('Enter a disk in drive A: and try again');
      end;
    end;
  end;
end;

end.

Regards, Geo
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now