File Attribute Changer

public
    { Public declarations }
    procedure GetAttr;
    function CheckFN(var fcount:word):boolean;
    function GetFirstFN(var files:string):string;
    procedure UnknownAttr;
    
//

procedure TForm1.Edit1DblClick(Sender: TObject);
var i:word;
    s:string;
begin
  if open_dlg.Execute then
    begin
      s:='';
      for i:=0 to open_dlg.Files.Count-1 do
        begin
          if s<>'' then s:=s+'|'+open_dlg.Files[i]
            else s:=open_dlg.Files[i];
        end;
      Edit1.Text:=s;
    end;
  CheckFN(i);
end;

function TForm1.GetFirstFN(var files:string):string;
var i:integer;
begin
  i:=pos('|',files);
  if i>0 then
    begin
      result:=copy(files,1,i-1);
      delete(files,1,i);
    end
    else result:=files;
end;

function TForm1.CheckFN(var fcount:word):boolean;
var s,fn:string;
    i:integer;
    fl:boolean;
begin
  s:=Edit1.Text;
  if Edit1.Text<>'' then
    begin
      fl:=true;
      fcount:=1;
    end
    else
      begin
        fl:=false;
        fcount:=0;
      end;
  i:=pos('|',s);
  while (i>0)and fl do
    begin
      inc(fcount);
      fn:=copy(s,1,i-1);
      delete(s,1,i);
      if not (fileexists(fn) or DirectoryExists(fn)) then fl:=false;
      i:=pos('|',s);
    end;
  if fl and (fcount=1) then
    if not (fileexists(s) or DirectoryExists(s)) then fl:=false;
  if fl and(fcount>0) then
    begin
      Edit1.ParentFont:=true;
      CheckListBox1.Enabled:=true;
      result:=true;
      Label1.Caption:=inttostr(fcount)+' succes';
    end
    else
      begin
        Edit1.Font.Color:=$0000FF;
        CheckListBox1.Enabled:=false;
        Label1.Caption:='failed';
        result:=false;
      end;
end;

procedure TForm1.UnknownAttr;
var i:integer;
begin
  for i:=0 to CheckListBox1.Count-1 do CheckListBox1.Checked[i]:=false;
end;

procedure TForm1.GetAttr;
var attr:cardinal;
    fcount:word;
    i:word;
    s,fn:string;

 procedure Switch_AttrCLB(idx:integer; value, fl_first:boolean);
 begin
  with CheckListBox1 do
    begin
      if fl_first then
        begin
          if value then state[idx]:=cbChecked
            else state[idx]:=cbUnchecked;
        end
        else
        begin
          if value and (state[idx]=cbChecked) then state[idx]:=cbChecked
            else
            if (value and (state[idx]=cbUnchecked))or((not value)and(state[idx]=cbChecked)) then state[idx]:=cbGrayed
              else
              if value and (state[idx]=cbGrayed) then state[idx]:=cbGrayed
                else
                  if (not value)and(state[idx]=cbUnchecked) then state[idx]:=cbUnchecked;
        end;
    end;
 end;

begin
  if not CheckFN(fcount) then
    begin
      UnknownAttr;
      exit;
    end;
  s:=Edit1.Text;
  CheckListBox1.AllowGrayed:=true;
  for i:=1 to fcount do
    begin
      fn:=GetFirstFN(s);
      attr:=windows.GetFileAttributes(PChar(fn));
      if (attr and faSysFile)<>0 then Switch_AttrCLB(0,true,(i=1))
        else Switch_AttrCLB(0,false,(i=1));
      if (attr and faHidden)<>0 then Switch_AttrCLB(1,true,(i=1))
        else Switch_AttrCLB(1,false,(i=1));
      if (attr and faReadOnly)<>0 then Switch_AttrCLB(2,true,(i=1))
        else Switch_AttrCLB(2,false,(i=1));
      if (attr and faArchive)<>0 then Switch_AttrCLB(3,true,(i=1))
        else Switch_AttrCLB(3,false,(i=1));
    end;
  CheckListBox1.AllowGrayed:=false;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var fcount:word;
begin
  if not CheckFN(fcount) then exit;
  GetAttr;
end;

procedure TForm1.CheckListBox1ClickCheck(Sender: TObject);
var attr,a:cardinal;
    i,fcount:word;
    s,fn:string;
begin
  if not CheckFN(fcount) then exit;
  s:=Edit1.Text;
  case CheckListBox1.ItemIndex of
    0:a:=faSysFile;
    1:a:=faHidden;
    2:a:=faReadOnly;
    3:a:=faArchive
    else a:=$FFFFFFFF;
  end;
  for i:=1 to fcount do
    begin
      fn:=GetFirstFN(s);
      attr:=windows.GetFileAttributes(PChar(fn));
      if CheckListBox1.State[CheckListBox1.ItemIndex] in [cbChecked, cbGrayed] then attr:=attr or a
        else attr:=(attr and ($FFFFFFFF - a));
      windows.SetFileAttributes(PChar(fn),attr);
    end;
  //showmessage(inttostr(attr));
  GetAttr;
end;

procedure TForm1.CheckListBox1Click(Sender: TObject);
begin
  //CheckListBox1.Checked[attr_clb.ItemIndex]:=not attr_clb.Checked[attr_clb.ItemIndex];
  CheckListBox1.OnClickCheck(self);
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAttr;
end;