There are those times when directory or file operations need to be handled programmatically. The BCSMCDirs component allows the technician to invoke many of those desired functions programmatically.
The primary functions are Move Sub Dir Contents, Copy Sub Dir Contents, Delete All Files and Sub Directories, Copy A File, Move A File, Delete A File, Rename A File and List All Files In A specific directory. Use the Rename A File function to change the extension of a file.
Subsequently the Rename A File can change the location of a file.
The component source code is depicted in the snippet below.
[codesyntax lang=”delphi”]
package BCSCMSdirpk;
{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}
requires
rtl,
vcl,
vclx,
BCSXE3Utilspk;
contains
BCSCMSdirdp in 'BCSCMSdirdp.pas',
BCSCMSdirU in 'BCSCMSdirU.pas' {BCSCMSdirC},
BCSMoveDirsU in 'BCSMoveDirs\BCSMoveDirsU.pas' {BCSMoveDirsC},
BCSDelFilesU in 'BCSDelFiles\BCSDelFilesU.pas' {BCSDelFilesC},
BCSMCFilesU in 'BCSMCFiles\BCSMCFilesU.pas' {BCSMCFilesC},
BCSSelADirU in 'BCSSelADir\BCSSelADirU.pas' {BCSSelADirC},
BCSRenameFileU in 'BCSRenameFile\BCSRenameFileU.pas' {BCSRenameFileC};
end.
[/codesyntax]
To copy the entire contents of a sub directory click on the Copy Confirm menu item and the following screen will appear.
When the user clicks on the Ok button prompts to select the Source and Destination directories and the following dialog appears.
The confirmation screen allows the user to proceed or cancel the operation. In this example the Yes button was clicked and the process completed successfully.
The user could then Click on the Select A File menu option and when the user navigates to the “C:\xp\xxx” sub directory the following dialog appears.
As we can see the entire contents of the source directory was populated in the destination directory.
For our next exercise we will move the contents of “C:\xp\xxx” to “C:\xp\aaa”. We have traversed selecting the source and destination directories and are now at the following dialog.
When the user click the Ok button the following confirmation dialog appears.
When the user click the Yes button the contents are moved from the source to the destination direction.
Now we will list all the files in the “C:\xp\aaa” sub directory.
As you can see our function performed the designed task flawlessly.
Below is the driver program for the component. It clearly outlines all of the available functions.
[codesyntax lang=”delphi”]
{*-----------------------------------------------------------------------------
Unit Name: BCSCMSdirdp
@Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
@Version 1.0
Date: 01-Jan-2014
Purpose:
History:
-----------------------------------------------------------------------------}
unit BCSCMSdirdp;
interface
uses
Forms, System.SysUtils, System.Classes, BCSCMSdirU, BCSMoveDirsU,
BCSDelFilesu, BCSMCFilesU, BCSSelADirU, BCSRenameFileU, Windows;
type
/// BCSCMSdir Primary Class
TBCSCMSdirCmp = class(TComponent)
private
{Private declarations}
protected
{Protected declarations}
/// Dialog Caption
FCaption: String;
/// Source Directory
FSource: String;
/// Destination Directory
FDest: String;
/// Selected File
FSelFile: String;
public
{Public declarations}
published
{Published declarations}
function BCSGetDirs: BooLean;
property RCaption: string read FCaption write FCaption;
function BCSCopyDir(const fromDir, toDir: string): BooLean;
function BCSMoveDir(const fromDir, toDir: string): BooLean;
function BCSDelDir(dir: string): BooLean;
function MBox(msg, cap: String; mbi: Integer): Integer;
property RSource: String read FSource write FSource;
property RDest: String read FDest write FDest;
function Confirm(atype: String): Integer;
function ConfDelete: Integer;
function SelectAFile: String;
property RSelFile: String read FSelFile write FSelFile;
procedure BCSShellFileOperation(fromFile: string; toFile: string;
Flags: Integer);
function SelADir: String;
Procedure CopyAFile;
Procedure MoveAFile;
Procedure DeleteAFile;
Procedure RenameAFile;
end;
procedure Register;
var
BCSCMSdirCmp: TBCSCMSdirCmp;
implementation
Uses ShellAPI;
{*-----------------------------------------------------------------------------
Procedure: RenameAFile
Date: 03-Jan-2014
@Param None
@Return None
-----------------------------------------------------------------------------}
Procedure TBCSCMSdirCmp.RenameAFile;
var
inf: string;
opf: String;
Begin
inf := Trim(SelectAFile);
Application.CreateForm(TBCSRenameFileC, BCSRenameFileC);
BCSRenameFileC.lblInFile.Caption := inf;
BCSRenameFileC.edtNewName.Text := inf;
if BCSRenameFileC.ShowModal = id_Ok then
begin
if (Trim(BCSRenameFileC.lblInFile.Caption)
= Trim(BCSRenameFileC.edtNewName.Text)) then
begin
MBox('File Name And New File Name Are The Same! Rename Abandoned',
'Old Name And New Name Match!', mb_ok);
end;
opf := Trim(BCSRenameFileC.edtNewName.Text);
RenameFile(inf, opf);
end;
BCSRenameFileC.Free;
End;
{*-----------------------------------------------------------------------------
Procedure: DeleteAFile
Date: 03-Jan-2014
@Param None
@Return None
-----------------------------------------------------------------------------}
Procedure TBCSCMSdirCmp.DeleteAFile;
var
inf: String;
begin
if Trim(SelectAFile) > '' then
begin
inf := RSelFile;
DeleteFile(PWideChar(inf));
end;
end;
{*-----------------------------------------------------------------------------
Procedure: CopyAFile
Date: 03-Jan-2014
@Param None
@Return None
-----------------------------------------------------------------------------}
Procedure TBCSCMSdirCmp.CopyAFile;
var
fname: String;
dir: String;
sdir: String;
inf: String;
begin
if Trim(SelectAFile) > '' then
begin
// BCSCMSdirCmp1.MBox('In Move File Function', 'Move A File', mb_OkCancel);
dir := Trim(SelADir);
If dir = '' then
begin
MBox('Desttination Directory Not Selected Move Is Abandon!',
'Directory Not Selected', mb_ok)
end
else
begin
inf := RSelFile;
sdir := ExtractFilePath(inf);
fname := ExtractFileName(inf);
if sdir = dir then
begin
MBox('Source And Destination Directories' + ' Match Move Is Abandoned!',
'Source And Destination Directories Cannot Match!', mb_ok);
end;
CopyFile(PWideChar(inf), PWideChar(dir + fname), true);
end;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: MoveAFile
Date: 03-Jan-2014
@Param None
@Return None
-----------------------------------------------------------------------------}
Procedure TBCSCMSdirCmp.MoveAFile;
var
fname: String;
dir: String;
sdir: String;
inf: String;
begin
if Trim(SelectAFile) > '' then
begin
// BCSCMSdirCmp1.MBox('In Move File Function', 'Move A File', mb_OkCancel);
dir := Trim(SelADir);
If dir = '' then
begin
MBox('Desttination Directory Not Selected Move Is Abandon!',
'Directory Not Selected', mb_ok)
end
else
begin
inf := RSelFile;
sdir := ExtractFilePath(inf);
fname := ExtractFileName(inf);
if sdir = dir then
begin
MBox('Source And Destination Directories' + ' Match Move Is Abandoned!',
'Source And Destination Directories Cannot Match!', mb_ok);
end;
MoveFile(PWideChar(inf), PWideChar(dir + fname));
end;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: MBox
Date: 02-Jan-2014
@Param msg, cap: String; mbi: Integer
@Return Integer
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.MBox(msg, cap: String; mbi: Integer): Integer;
begin
Result := MessageBox(Application.Handle, PWideChar(msg), PWideChar(cap), mbi);
end;
{*-----------------------------------------------------------------------------
Procedure: BCSCopyDir
Date: 02-Jan-2014
@Param const fromDir, toDir: string
@Return BooLean
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.BCSCopyDir(const fromDir, toDir: string): BooLean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PWideChar(fromDir + #0);
pTo := PWideChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
{*-----------------------------------------------------------------------------
Procedure: BCSMoveDir
Date: 02-Jan-2014
@Param const fromDir, toDir: string
@Return BooLean
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.BCSMoveDir(const fromDir, toDir: string): BooLean;
var
fos: TSHFileOpStructW;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PWideChar(fromDir + #0);
pTo := PWideChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
{*-----------------------------------------------------------------------------
Procedure: BCSDelDir
Date: 02-Jan-2014
@Param dir: string
@Return BooLean
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.BCSDelDir(dir: string): BooLean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
{*-----------------------------------------------------------------------------
Procedure: BCSGetDirs
Date: 02-Jan-2014
@Param None
@Return BooLean
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.BCSGetDirs: BooLean;
begin
Result := false;
Application.CreateForm(TBCSCMSdirC, BCSCMSdirC);
if RCaption > '' then
begin
BCSCMSdirC.Caption := RCaption;
end;
if BCSCMSdirC.ShowModal = id_Ok then
begin
RSource := BCSCMSdirC.lblSDir.Caption;
RDest := BCSCMSdirC.lblDest.Caption;
Result := true;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: Confirm
Date: 03-Jan-2014
@Param atype: String
@Return Integer
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.Confirm(atype: String): Integer;
var
ires: Integer;
fos: TSHFileOpStruct;
fdir, tdir: String;
begin
Result := id_No;
Application.CreateForm(TBCSMoveDirsC, BCSMoveDirsC);
BCSMoveDirsC.lblSource.Caption := RSource;
BCSMoveDirsC.lblMoveOrCopy.Caption := atype;
BCSMoveDirsC.lblDest.Caption := RDest;
if RCaption > '' then
begin
BCSMoveDirsC.Caption := RCaption;
end;
ires := BCSMoveDirsC.ShowModal;
if ires = id_Yes then
begin
RSource := BCSMoveDirsC.lblSource.Caption;
RDest := BCSMoveDirsC.lblDest.Caption;
fdir := RSource;
tdir := RDest;
// ForceDirectories(RDest);
if atype = 'Move' then
begin
//BCSCMSdirCmp.MBox('In Move Function', 'Function Is Move', mb_OkCancel);
BCSCMSdirCmp.BCSMoveDir(fdir, tdir);
end
else
begin
//BCSCMSdirCmp.MBox('In Copy Function', 'Function Is Copy', mb_OkCancel);
BCSCMSdirCmp.BCSCopyDir(fdir, tdir);
end;
Result := ires;
end
else
begin
BCSCMSdirCmp.MBox('No Files Processed!', 'Function Terminated By User!',
mb_OkCancel)
end;
end;
{*-----------------------------------------------------------------------------
Procedure: ConfDelete
Date: 03-Jan-2014
@Param None
@Return Integer
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.ConfDelete: Integer;
var
rdir: String;
ires: Integer;
begin
Result := id_No;
Application.CreateForm(TBCSDelFilesC, BCSDelFilesC);
rdir := BCSDelFilesC.BCSXE3UtilsCmp1.SelADir;
if rdir > '' then
begin
BCSDelFilesC.Caption := 'BCS Delete All Files In Sub Directory';
BCSDelFilesC.lblSubDir.Caption := rdir;
ires := BCSDelFilesC.ShowModal;
if ires = id_Yes then
begin
Result := ires;
{BCSCMSdirCmp.MBox('In Delete All Function', 'Function Is Delete All',
mb_OkCancel); }
BCSCMSdirCmp.BCSDelDir(rdir);
end;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: SelectAFile
Date: 03-Jan-2014
@Param None
@Return String
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.SelectAFile: String;
begin
Result := '';
Application.CreateForm(TBCSMCFilesC, BCSMCFilesC);
BCSMCFilesC.Caption := 'BCS Select A File!';
if BCSMCFilesC.ShowModal = id_Ok then
begin
RSelFile := BCSMCFilesC.RSelFile;
Result := RSelFile;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: BCSShellFileOperation
Date: 03-Jan-2014
@Param fromFile: string; toFile: string; Flags: Integer
@Return None
-----------------------------------------------------------------------------}
procedure TBCSCMSdirCmp.BCSShellFileOperation(fromFile: string; toFile: string;
Flags: Integer);
var
shellinfo: TSHFileOpStruct;
begin
with shellinfo do
begin
wnd := Application.Handle;
wFunc := Flags;
pFrom := PWideChar(fromFile);
pTo := PWideChar(toFile);
end;
ShellAPI.ShFileOperation(shellinfo);
end;
{*-----------------------------------------------------------------------------
Procedure: SelADir
Date: 03-Jan-2014
@Param None
@Return String
-----------------------------------------------------------------------------}
function TBCSCMSdirCmp.SelADir: String;
begin
Application.CreateForm(TBCSSelADirC, BCSSelADirC);
BCSSelADirC.SelectADirectory1.Click;
Result := BCSSelADirC.RSelADir;
end;
{*-----------------------------------------------------------------------------
Procedure: Register
Author: AMB01
Date: 09-May-2013
Arguments: None
Result: None
-----------------------------------------------------------------------------}
procedure Register;
begin
RegisterComponents('AB Comps', [TBCSCMSdirCmp]);
end;
end.
[/codesyntax]
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.