Kopiering med subdirs i console

Her er en comp. du kan bruge til at få en liste af filer du skal slette så er det jo bare at lave en løkke og kalde DeleteFile();

/Martin

unit uScanner;

interface

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

type
  TScannerMode = (dsmFiles,dsmDirectory);

  TDiskScannerAddToFileEvent = function( Sender : TObject; aFilename : String; aFileRec : TSearchRec ) : Boolean of object;

  TDiskScanner = class(TComponent)
  private
    FScanSubDirs: Boolean;
    FPath: String;
    FOnAddToList: TDiskScannerAddToFileEvent;
    FScanMode: TScannerMode;
    FFiles: TStrings;
    FLastScanError : String;
    FLevel : Integer;
    FMask: String;
    procedure SetOnAddToList(const Value: TDiskScannerAddToFileEvent);
    procedure SetPath(const Value: String);
    procedure SetScanMode(const Value: TScannerMode);
    procedure SetScanSubDirs(const Value: Boolean);
    procedure SetFiles(const Value: TStrings);
    procedure ScanDir(const aPath: String; Subs: Boolean; const L: TStrings);
    procedure ScanFiles(const aPath: String; Subs: Boolean; const L: TStrings);
    procedure SetMask(const Value: String);
  protected
  public
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;

    function Execute : Boolean;
  published
    property Path : String read FPath write SetPath;
    property Mask : String read FMask write SetMask;
    property ScanSubDirs : Boolean read FScanSubDirs write SetScanSubDirs;
    property ScanMode : TScannerMode read FScanMode write SetScanMode;
    property Files : TStrings read FFiles write SetFiles;
    property OnAddToList : TDiskScannerAddToFileEvent read FOnAddToList write SetOnAddToList;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('NSD32', [TDiskScanner]);
end;

{ TDiskScanner }

constructor TDiskScanner.Create(AOwner: TComponent);
begin
  inherited;
  FFiles := TStringList.Create;
  FMask := '*.*';
end;

destructor TDiskScanner.Destroy;
begin
  FFiles.Free;
  inherited;
end;

procedure TDiskScanner.ScanFiles( const aPath : String; Subs : Boolean; const L : TStrings );
VAR
  S  : TSearchRec;
  CPath : String;
begin
  ChDir(aPath);
  GetDir(0,CPath);
  if FindFirst(IncludeTrailingPathDelimiter(CPath)+FMask,faANYFILE,S) = 0 then
  repeat
      if ( S.Attr and faSysFile = 0 ) and ( S.Attr and faDIRECTORY = 0 ) and
        ( S.Attr and faVolumeID = 0 ) and ( S.Name <> '.' ) and ( S.Name <> '..' ) then
      begin
        if Assigned(FOnAddToList) then
        begin
            if FOnAddToList(Self,IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,S) then
            L.AddObject(IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,TObject(FLevel));
        end else L.AddObject(IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,TObject(FLevel));
      end;
  until FindNext(S) <> 0;
  FindClose(S);

  if Subs and ( FindFirst(FMask,faDIRECTORY,S) = 0 ) then
  repeat
      if ( S.Attr and faDIRECTORY <> 0 ) and ( S.Name <> '.' ) and ( S.Name <> '..' ) then
      begin
        Inc(FLevel);
        ScanFiles(IncludeTrailingPathDelimiter(CPath)+S.Name,Subs,L);
        Dec(FLevel);
        ChDir('..');
      end;
  until FindNext(S) <> 0;
  FindClose(S);
end;

procedure TDiskScanner.ScanDir( const aPath : String; Subs : Boolean; const L : TStrings );
VAR
  S  : TSearchRec;
  CPath : String;
begin
  ChDir(aPath);
  GetDir(0,CPath);
  if Subs and ( FindFirst(FMask,faDIRECTORY,S) = 0 ) then
  repeat
      try
        if ( S.Attr and faDIRECTORY <> 0 ) and ( S.Name <> '.' ) and ( S.Name <> '..' ) then
        begin
          if Assigned(FOnAddToList) then
          begin
              if FOnAddToList(Self,IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,S) then
              L.AddObject(IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,TObject(FLevel));
          end else L.AddObject(IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,TObject(FLevel));
          Inc(FLevel);
          ScanDir(IncludeTrailingPathDelimiter(CPath)+S.FindData.cFileName,Subs,L);
          Dec(FLevel);
          ChDir('..');
        end;
        except
          on E:Exception do FLastScanError := E.Message;
      end;
  until FindNext(S) <> 0;
  FindClose(S);
end;

function TDiskScanner.Execute: Boolean;
begin
  Result := TRUE;
  FFiles.Clear;
  FLevel := 0;
  case FScanMode of
    //dsmFiles      : ScanFiles(IncludeTrailingBackslash(FPath),FScanSubDirs,FFiles);
    dsmFiles      : ScanFiles(FPath,FScanSubDirs,FFiles);
    //dsmDirectory  : ScanDir(IncludeTrailingBackslash(FPath),FScanSubDirs,FFiles);
    dsmDirectory  : ScanDir(FPath,FScanSubDirs,FFiles);
  end;
end;

procedure TDiskScanner.SetFiles(const Value: TStrings);
begin
  FFiles.Assign(Value);
end;

procedure TDiskScanner.SetOnAddToList( const Value: TDiskScannerAddToFileEvent);
begin
  FOnAddToList := Value;
end;

procedure TDiskScanner.SetPath(const Value: String);
begin
  FPath := ExtractFilePath(Value);
end;

procedure TDiskScanner.SetScanMode(const Value: TScannerMode);
begin
  FScanMode := Value;
end;

procedure TDiskScanner.SetScanSubDirs(const Value: Boolean);
begin
  FScanSubDirs := Value;
end;

procedure TDiskScanner.SetMask(const Value: String);
begin
  FMask := Value;
end;

end.

Ellers kan du bare bruge den her :
http://borrisholt.com/FileIO/DelphiSource/Filehandling.zip

Jeg vil gerne vide hvordan man skjuler dialog boksen ...

Jens B

"dialog boksen".Skjul := TRUE; 

:-0

no := HEST :-)

Æhm... i en console app kan jeg ikke bruge komponenter... Desuden er der ikke nogen CopyFile funktion i console...

loproc >> Hvem snakker om kompionenter ? Og jo den kan du også bruge i en Console.

Anyway .. Mit kode virker fint i en Console. Hvis du er intreseret vil jeg gerne lave et eksemåpel til dig ....

Jens B

WinAPI :

The CopyFile function copies an existing file to a new file.

BOOL CopyFile(

    LPCTSTR lpExistingFileName,    // pointer to name of an existing file
    LPCTSTR lpNewFileName,    // pointer to filename to copy to
    BOOL bFailIfExists     // flag for operation if file exists
  );

borrisholt -> Et eksempel ville være meget rart...

Installer min comp. og lav følgende Console App :

-------------------------------

uses
  Windows, SysUtils, uScanner;


procedure CopyDir( Source,Dest : String; WithSub : Boolean );
VAR
  Cnt  : Integer;
  DS  : TDiskScanner;
  Strx : String;
begin
  DS := TDiskScanner.Create(NIL);
  DS.Path := Source;
  DS.ScanSubDirs := TRUE;
  DS.Execute;
  for Cnt := 0 to DS.Files.Count-1 do
  begin
      Strx := IncludeTrailingPathDelimiter(Dest) + StringReplace(DS.Files[Cnt],IncludeTrailingPathDelimiter(Source),'',[]);
      ForceDirectories(ExtractFilePath(Strx));
      if not CopyFile(PChar(DS.Files[Cnt]),PChar(Strx),FALSE) then WriteLn('Error : '+DS.Files[Cnt]);
  end;
end;

begin
  if ParamCount = 2 then
    CopyDir(ParamStr(1),ParamStr(2),TRUE)
  else
  if ParamCount = 3 then
    CopyDir(ParamStr(1),ParamStr(2),UpperCase(ParamStr(3)) = '/S')
  else
  begin
      WriteLn;
      WriteLn('DelXcopy :');
      WriteLn('DelXcopy <Source Path> <Dest Path> /S');
      WriteLn;
      WriteLn('/S = With Subs ( Default )');
      WriteLn;
  end;
end.

/Martin

Du havde ganske ret! Det virker sq'! Takker!
Troede bare ikke man kunne bruge Windows unit'en i en console app... det lyder lidt paradoksalt...

Nej der er du lidt galt på den, VCL'en er GUI orienteret mange andre units er ikke sysutils f.eks., men Windows er et styresystem dvs. det er også windows når det er en console app. du kører og en console app er en 32bit windows console app. den kører ikke med en rigtig DOS 6.22.


/Martin

Så proggyet kan altså ikke køre i real dos? Kun i en skide console?
I så fald kan jeg jo ike bruge det til en ski...

DOS er 16 bit, win er 32bit ( plus alle de andre forskelle ), du kunne få Delphi 1 til at lave DOS programmer, du kan finde opskriften på borloand.com

/Martin

Turbo Pascal!

Version 5.5 kan hentes gratis på borlands site

Så bør du ikke bruge udtrykken en Console Application !

Jeg kan sikkert godt skrive dig sådan en dims til dig der kan det hele. Men så bliver det i Turbo pascal.

Jens B