D6: hjælp til program som skal scanne efter filer

Var det ikke bedre at sætte nogle rettigheder op så de ikke har mulighed for at gemme filer i alle mulige mapper?

vi har desværre ikke en server-struktur, så det kan spærres af. jeg har dog prøvet at lave en gæste account med begrænset adgang, men "kreative" sjæle er kommet uden om denne account og kommet bag systemet.

Til inspiration:

program Scan;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, Windows;

procedure drivescan(dirnam : string; target: TStringList);

var
  sr: TSearchRec;
  ix : integer;

begin

  if FindFirst(dirnam + '*', -1, sr) = 0 then begin
    repeat
      if (sr.Attr and faDirectory) <> 0 then begin
        if (sr.Name <> '.') and (sr.Name <> '..') then begin
          drivescan(dirnam + sr.Name + '\', target);
        end;
      end else begin
        if target.Find(ExtractFileExt(sr.Name), ix) then begin
          writeln(dirnam + sr.Name);
        end;
      end;
    until FindNext(sr) <> 0;
    SysUtils.FindClose(sr);
  end;
end;

var
  letter : char;
  drive : string;
  target : TStringList;

begin
  target := TStringList.Create;
  target.Add('.bat');
  for letter := 'A' to 'Z' do begin
    drive := letter + ':\';
    if GetDriveType(PChar(drive)) = DRIVE_FIXED then begin
      drivescan(drive, target);
    end;
  end;
  target.Free;
  readln;
end.

1000 tak, så er der lidt at arbejde på :-)

Hvad med at lave en månedlig ordning med at overskrive harddiskene med "rene" installationer. Altså noget med at bruge Ghost (der findes også Open Source varianter) til at smække nye images på diskene. Det kan den næsten klare automatisk. Med jævne mellemrum skal der tages nye kopier så Windows-opdateringerne kommer med.

Mon ikke rollingerne ville blive så trætte af den ordning, at de hoppede over på deres bærbare i stedet?

I øvrigt er dit spørgsmål ikke det første af slagsen. Er lige ved at tro det nærmest er topscorer herinde. Havde du søgt havde du også fundet de første 10 løsninger i stil med Arnes. Hans finesse er, at den bruger GetDriveType til at undgå netværk og cd-rommer.

Der var nogle småting med Arnes eksempel (såsom af Find ikke skal bruges på andet end sorterede lister, at eksemplet ikke var korrekt idet writeln-linjen skulle tilføje til target og at '*.bat'-masken aldrig blev brugt).

Her kommer output til en TStrings som bl.a findes i en TCheckListBox (hvorfra du efterfølgende kan vælge filerne du vil slette).

Her får du ovenstående kørt gennem skoleeksempelmøllen:

procedure ScanFixedDrives(aList: TStrings; const aMask: string);

  procedure ScanDrive(const aPath, aMask: string; aList: TStrings);
  var
    Mask: TMask;
    OK: boolean;
    sr: TSearchRec;
  begin
    OK := SysUtils.FindFirst(aPath + '*', faAnyFile, sr) = 0;
    Mask := TMask.Create(aMask);
    try
      while OK do
      begin
        if (sr.Attr and faDirectory) <> 0 then
        begin
          if (sr.Name <> '.') and (sr.Name <> '..') then
            ScanDrive(IncludeTrailingPathDelimiter(aPath + sr.Name), aMask, aList); // Scan deeper
        end
        else if Mask.Matches(sr.Name) then
          aList.Add(aPath + sr.Name);

        OK := SysUtils.FindNext(sr) = 0;
      end;
    finally
      Mask.Free;
      SysUtils.FindClose(sr);
    end;
    Application.ProcessMessages;
  end;

var
  Root: string;
  DriveLetter: char;
begin
  aList.BeginUpdate;
  try
    aList.Clear;
    for DriveLetter := 'A' to 'Z' do
    begin
      Root := IncludeTrailingPathDelimiter(DriveLetter + ':');
      if GetDriveType(PChar(Root)) = DRIVE_FIXED then
        ScanDrive(Root, aMask, aList);
    end;
  finally
    aList.EndUpdate;
  end;
end;

procedure TfrmMain.btnScanClick(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  try
    ScanFixedDrives(lbFiles.Items,'*.dll'); // lb = ListBox
  finally
    Screen.Cursor := crDefault;
  end;
end;

Endelig burde algoritmen laves i en tråd så den kunne stoppes igen (så kunne Application.ProcessMessages fjernes igen)

Jeg tror du har misforstået hvad min kode gør.

Den bruger '.bat' og det er helt tilsigtet at den ikke tilføjer til listen.

Hvis den skulle slette, så skal writeln erstattes af en slet. Men da jeg sætter pris
på mine .bat filer ville jeg ikke teste med det.

Jamen arne. Jeg kan dælme ikke se hvor din Add('*.bat') bliver brugt. Kan heller ikke se hvad target er til for. Den bliver sendt med rundt men der bliver aldrig tilføjet noget i den. Hvis din kode virker (og det mangler jeg at teste), så forstår jeg ikke hvorfor.

Target indeholder de extensions der skal ledes efter.

Så hvis man både skulle lede efter både .bat og .py så ville man lave:

target.Add('.bat');
target.Add('.py');

så kan man finde begge typer i et enkelt gennemløb af disken.

Jeg lavede det på den måde fordi spørgsmålet gik på at finde 6 forskellige fil typer.

Og at scanne disken 6 gange virkede meget uhensigtsmæssigt for mig.

Den bruges ved:

if target.Find(ExtractFileExt(sr.Name), ix) then

Det er øjnene man først bliver blind på... Det, og jeg havde kigget det igennem en del gange, overså jeg aldeles. En fiks måde at føre det med over på, men jeg tror Find i stedet for IndexOf forvirrede mig. Her er min modificerede version.

uses
  UProperties, UShared, UCPR, USystClasses, Graphics, CommCtrl, Math, Masks, ContNrs;

{$R *.dfm}

procedure ScanFixedDrives(const aMaskString: string; aList: TStrings);

  procedure ScanDrive(const aPath: string; aMasks: TObjectList; aList: TStrings);
  var
    i: integer;
    sr: TSearchRec;
    IsFound, IsMatch : boolean;
  begin
    IsFound := SysUtils.FindFirst(aPath + '*', faAnyFile, sr) = 0;
    try
      while IsFound do
      begin
        if (sr.Attr and faDirectory) <> 0 then
        begin
          if (sr.Name <> '.') and (sr.Name <> '..') then
            ScanDrive(IncludeTrailingPathDelimiter(aPath + sr.Name), aMasks, aList); // Scan deeper
        end
        else begin
          i := -1; IsMatch := false;
          while (i < aMasks.Count - 1) and not IsMatch do
          begin
            inc(i);
            IsMatch := (aMasks[i] as TMask).Matches(sr.Name);
          end;
          if IsMatch then
            aList.Add(aPath + sr.Name);
        end;
        IsFound := SysUtils.FindNext(sr) = 0;
      end;
    finally
      SysUtils.FindClose(sr);
    end;
    Application.ProcessMessages;
  end;

var
  i: integer;
  Root: string;
  DriveLetter: char;
  Masks: TObjectList;
  MaskStrings: TStringList;
begin
  Masks := TObjectList.Create;
  aList.BeginUpdate;
  try
    MaskStrings := TStringList.Create;
    try
      MaskStrings.Delimiter := ';';
      MaskStrings.DelimitedText := aMaskString;
      for i := 0 to MaskStrings.Count - 1 do
        Masks.Add(TMask.Create(MaskStrings[i]));
    finally
      MaskStrings.Free;
    end;

    aList.Clear;
    for DriveLetter := 'A' to 'Z' do
    begin
      Root := IncludeTrailingPathDelimiter(DriveLetter + ':');
      if GetDriveType(PChar(Root)) = DRIVE_FIXED then
        ScanDrive(Root, Masks, aList);
    end;
  finally
    aList.EndUpdate;
    Masks.Free;
  end;
end;

Uses listen blev lidt lang. Det var kun de her der skulle bruges: Masks og ContNrs

nu er jeg meget nygerrig efter at have set de 2 eksempler, hvordan kunne man få de scannede filer præsenteret i en alm. listbox?

Kopierer lige fra en tidligere kommentar:

procedure TfrmMain.btnScanClick(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  try
    ScanFixedDrives(lbFiles.Items,'*.dll'); // lb = ListBox
  finally
    Screen.Cursor := crDefault;
  end;
end;

Nævnte også, at det var underordnet om du brugte en TListbox (her navngivet lbFiles) eller en TCheckListBox (navngives clbFiles), idet deres Items begge nedarver fra TStrings og det er den slags ScanFixedDrives tager som argument.

Meget spændende, jeg har lært en del af de eksempler der er vist, de har været til super meget hjælp, jeg har dog et lille spørgsmål tilbage.

Kan man få den til at søge efter flere filtyper samtidlig eks: *.mp3 og *.avi etc...
eller skal man importere et loop?

Det kan begge eksempler allerede.

I Arnes eksempel skal du bare tilføje flere kriteria efter der hvor han tilføjer '*.bat' til target.
I mit (sidste eksempel) er syntaksen lidt anderledes idet du her skal angive det i aMaskString, adskilt af et semikolon, eksempelvis: '*.bat;*.bak;*.mp3'

hmmm det ser ud til den scanner på livet løs hvis jeg tilføjer flere extentions, men den overfører ikke resultatet til min listbox mere, sætter jeg kun 1 extention på så kan den fint vise resultatet i listboxen, hvad kan årsagen være til det?

Det kunne nok være interessant at se hvilke fil-kriterier du fodrer proceduren med. Mistænker det er der den er gal, for jeg får fint data hentet ud på strengen '*.dll;*.pas;*.mp3'

meget mystisk... min kode ser ud som følger:

unit Unit1;

interface

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

type
  TTfrmMain = class(TForm)
    listbox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  TfrmMain: TTfrmMain;

implementation

{$R *.dfm}
procedure ScanFixedDrives(aList: TStrings; const aMask: string);

  procedure ScanDrive(const aPath, aMask: string; aList: TStrings);
  var
    Mask: TMask;
    OK: boolean;
    sr: TSearchRec;
  begin
    OK := SysUtils.FindFirst(aPath + '*', faAnyFile, sr) = 0;
    Mask := TMask.Create(aMask);
    try
      while OK do
      begin
        if (sr.Attr and faDirectory) <> 0 then
        begin
          if (sr.Name <> '.') and (sr.Name <> '..') then
            ScanDrive(IncludeTrailingPathDelimiter(aPath + sr.Name), aMask, aList); // Scan deeper
        end
        else if Mask.Matches(sr.Name) then
          aList.Add(aPath + sr.Name);

        OK := SysUtils.FindNext(sr) = 0;
      end;
    finally
      Mask.Free;
      SysUtils.FindClose(sr);
    end;
    Application.ProcessMessages;
  end;

var
  Root: string;
  DriveLetter: char;
begin
  aList.BeginUpdate;
  try
    aList.Clear;
    for DriveLetter := 'A' to 'Z' do
    begin
      Root := IncludeTrailingPathDelimiter(DriveLetter + ':');
      if GetDriveType(PChar(Root)) = DRIVE_FIXED then
        ScanDrive(Root, aMask, aList);
    end;
  finally
    aList.EndUpdate;
  end;
end;

procedure TTfrmMain.FormCreate(Sender: TObject);
begin
Screen.Cursor := crHourglass;
  try
    ScanFixedDrives(listbox1.Items,'*.mp3;*.avi;*.zip;*.rar');
    finally
    Screen.Cursor := crDefault;
end;
end;
end.

Måske har jeg lavet en fejl?

Prøv lige at bruge det sidste eksempel jeg postede (skrev bl.a. også at man først blev blind på øjnene (min fars ord) ... :-))

(i øvrigt noget han risikerer at blive efter en nethindeløsning, men det er en anden historie)

hmm den kode kan jeg nemlig ikke få til at fungere den delphi brokker sig over procedure" procedure ScanFixedDrives(aList: TStrings; const aMask: string);"
og forkert syntax, i det eksempel kan jeg heller ikke lige gennemskue hvor file-extentions kommer ind i billedet. Måske er det bare mig som er lidt for rookie på delphi :-)

Den kode kunne jeg kopiere direkte over i min D2007'er hvorfra den virkede fint. Vil også - hvis jeg ellers havde en - æde min gamle hat, at det vil virke på den D7'er jeg har på arbejdet. Hvis nu du var lidt bedre til at beskrive fejlen, så kunne jeg nok komme op med en D6'variant. Prøv at sende mig en fejlbeskrivelse. Du har bemærket jeg har byttet rundt på parametrene i kaldet, ikke? Du kan kompilere, ikke?

Mht. fil-extensionerne. Jeg tager en streng eksempelvis med indholdet '*.bat;*.pas;*.mp3' og fodrer den til en TStringLists DelimitedText. Derved bliver strengen hakket op i bidder, så TStringListen nu indeholder 3 strenge, førnævnte *.bat, *.pas og *.mp3. De tre strenge bruger jeg til at oprette 3 instanser af TMasks, en for hvert kriterie. Disse objekter bankes ind i et array af TMasks som jeg sender til ScanDrive. ScanDrive som løber den igennem for hver fil og hvis et af kriterierne er opfyldt, tilføjes filen.

Det smarte ved at oprette dem udenfor ScanDrive er, at man ikke skal oprette n TMasks, tjekke og frigive dem igen for hver fil.

hmmm hvis jeg kopierer den direkte ind i delphi 6 får jeg følgende fejl:

[Error] Unit1.pas(25): Undeclared identifier: 'TObjectList'
[Error] Unit1.pas(42): ')' expected but identifier 'Count' found
[Error] Unit1.pas(45): Undeclared identifier: 'TMask'
[Error] Unit1.pas(65): Missing operator or semicolon
[Error] Unit1.pas(73): Missing operator or semicolon
[Error] Unit1.pas(73): EXCEPT or FINALLY expected
[Error] Unit1.pas(76): EXCEPT or FINALLY expected
[Error] Unit1.pas(85): 'END' expected but 'FINALLY' found
[Error] Unit1.pas(89): '.' expected but ';' found
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

Du er altså ikke særlig god til at kopiere. Mistænker alle fejlene skyldes du ikke kopierer (og jeg rettede det endda uden du bemærkede at det måske havde relevans: "Uses listen blev lidt lang. Det var kun de her der skulle bruges: Masks og ContNrs"). Prøv at inkludere de to units.

Havde du stillet markøren over teksten TObjectList og trykket F1 så havde du også fået at vide hvilken unit du skulle inkludere. Delphi siger endda: "Jeg kender ikke TObjectList" - mon ikke den ligger i en unit et sted?

Hvis du efterhånden fornemmer en vis irritation fra min side, så er det korrekt. Vi bruger tid på at frembringe pæne skoleeksempler udi at traversere Windows' kataloger og du går i stå på steder, hvor du burde være selvhjulpen. Selvhjulpen som i blot at læse den tekst og kode vi "poster" - og derved forbruge mere af den tid som jeg i alt fald ikke har (og ja, jeg har haft en dårlig morgen).