Solved

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

Posted on 2003-10-23
1
255 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi - replicating a form 8 62
Multiple image collision 13 69
Delphi: Connect to running MS Outlook 4 47
Dynamically Created Query 3 50
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
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…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.
A company’s greatest vulnerability is their email. CEO fraud, ransomware and spear phishing attacks are the no1 threat to a company’s security. Cybercrime is responsible for the largest loss of money to companies today with losses projected to r…

914 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

21 Experts available now in Live!

Get 1:1 Help Now