Delphida tizimli Commander dasturini yaratish

Muallif: Mengliyev SH.

Qo`shilgan sana: 2015-04-01

Delphida tizimli Commander dasturini yaratish

Dastur kodi

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, StdCtrls, ExtCtrls, FileCtrl, Buttons,
  ToolWin;

type
  TForm1 = class(TForm)
    Dick1: TShellComboBox;
    File1: TShellListView;
    Dick2: TShellComboBox;
    File2: TShellListView;
    P1: TPanel;
    Exit: TButton;
    P2: TPanel;
    CopyF: TButton;
    RePlace: TButton;
    ReName: TButton;
    NewFolder: TButton;
    Delete: TButton;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    Up1: TSpeedButton;
    Up2: TSpeedButton;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    procedure ExitClick(Sender: TObject);
    procedure Up1Click(Sender: TObject);
    procedure Up2Click(Sender: TObject);
    procedure CopyFClick(Sender: TObject);
    procedure File1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure File2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RePlaceClick(Sender: TObject);
    procedure ReNameClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure NewFolderClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure File1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure File1DragDrop(Sender, Source: TObject; X, Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  Tfile=file;

var
  Form1: TForm1;
  FromF, ToF : TFile;
  Buf : array [1..4096] of char;
  NumRead, NumWritten: Integer;
  enableF:boolean;

implementation

{$R *.dfm}

procedure Copy(var FromF, ToF : TFile);
begin
repeat
  BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
  BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
end;

procedure TForm1.ExitClick(Sender: TObject);
begin
  Application.terminate;
end;

procedure TForm1.Up1Click(Sender: TObject);
begin
    file1.Back;
end;

procedure TForm1.Up2Click(Sender: TObject);
begin
  file2.Back;
end;

function GetR(s:string):string
var i:integer;
begin
  result:='';
  i:=length(s);
  while (i>0) and (result='') do begin
    if s[i]='\' then i:=0;
    if s[i]='.' then break;
    if i<>0 then dec(i);
  end;
  if i<>0 then
    result:=system.copy(s,i,length(s)-i+1);
end;

procedure TForm1.CopyFClick(Sender: TObject);        // faylni ko’chirish
var
  f:Tshellfolder;
  s:string;
begin
  if file1.RootFolder.PathName<>file2.RootFolder.PathName then
    if EnableF then begin
      f:=file1.SelectedFolder;
      if assigned(f) then assignfile(fromF,f.PathName);
      {$I-}
        reset(fromf,1);
      {$I+}
      if ioresult=0 then begin
        if getR(f.DisplayName)='' then
          s:=getR(f.PathName)
        else
          s:='';
        assignfile(toF,file2.RootFolder.PathName+'\'+f.DisplayName+s);
        {$I-}
          rewrite(toF,1);
        {$I+}
        if ioresult=0 then begin
          copy(fromf,tof);
          closefile(tof);
          file2.Refresh;
        end;
        closefile(fromf);
      end;
    end
    else begin
      f:=file2.SelectedFolder;
      if assigned(f) then assignfile(fromF,f.PathName);
      {$I-}
        reset(fromf,1);
      {$I+}
      if ioresult=0 then begin
        if getR(f.DisplayName)='' then
          s:=getR(f.PathName)
        else
          s:='';
        assignfile(toF,file1.RootFolder.PathName+'\'+f.DisplayName+s);
        {$I-}
          rewrite(toF,1);
        {$I+}
        if ioresult=0 then begin
          copy(fromf,tof);
          closefile(tof);
          file1.Refresh;
        end;
        closefile(fromf);
      end;
    end;
end;

procedure TForm1.File1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  enableF:=true;//file1
end;

procedure TForm1.File2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Enablef:=false;//file2
end;

procedure TForm1.RePlaceClick(Sender: TObject);      // fayl nomini o’zgartirish
begin
  CopyFclick(sender);                    //nusha ko’chirish
   {$I-}
    reset(tof);
  {$I+}
  if ioresult=0 then begin             
    closefile(tof);
    {$I-}
      reset(fromF);
    {$I+}
    if ioresult=0 then begin           
      closefile(fromF);
      erase(fromF);                    
      if enableF then
        file1.Refresh
      else
        file2.Refresh;
    end;
  end;
end;

procedure TForm1.ReNameClick(Sender: TObject);
var
  f:TshellFolder;
begin
  if enableF then begin
    f:=file1.SelectedFolder;
    if assigned(f) then begin
      panel1.visible:=true;
      p1.Enabled:=false;
      p2.Enabled:=false;
      edit1.Text:=f.DisplayName;
    end;
  end
  else begin
    f:=file1.SelectedFolder;
    if assigned(f) then begin
      panel1.Visible:=true;
      p1.Enabled:=false;
      p2.Enabled:=false;
      edit1.Text:=f.DisplayName;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  panel1.Visible:=false;
  p1.Enabled:=true;
  p2.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  f:TshellFolder;
begin
  if enableF then begin
    f:=file1.SelectedFolder;
    if f.Rename(edit1.Text) then begin
      panel1.Visible:=false;
      p1.Enabled:=true;
      p2.Enabled:=true;
      file1.Refresh;
    end
    else
      showmessage('O`gartirib bo`lmaydi!!!(Sinvolni yoki faylda ruhsat yo’q)');
  end
  else begin
    f:=file2.SelectedFolder;
    if f.Rename(edit1.Text) then begin
      panel1.Visible:=false;
      p1.Enabled:=true;
      p2.Enabled:=true;
      file2.Refresh;
    end
    else
      showmessage('O`gartirib bo`lmaydi!!!(Sinvolni yoki faylda ruhsat yo’q)');
  end;
end;

function MyRemoveDir(sDir: string): Boolean;
var
  iIndex: Integer;
  SearchRec: TSearchRec;
  sFileName: string;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
    if SearchRec.Attr = faDirectory then
      begin
        if (SearchRec.name <> '' ) and
           (SearchRec.name <> '.') and
           (SearchRec.name <> '..') then
          MyRemoveDir(sFileName);
      end
    else begin
      if SearchRec.Attr <> faArchive then
        FileSetAttr(sFileName, faArchive);
      if not DeleteFile(sFileName) then
        ShowMessage('Немогу удалить ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);

  RemoveDir(ExtractFileDir(sDir));
  Result := True;
end;

procedure TForm1.NewFolderClick(Sender: TObject);
var f:file;
    folder:TShellFolder;
    s:string;
begin
  if enablef then begin
    s:=file1.RootFolder.PathName;
    if length(s)>3 then s:=s+'\';
    if not createdir(s+'NewFolder') then
      showmessage(' Katolog yaratib bo’lmaydi ')
    else
      file1.Refresh;
  end
  else begin
    s:=file2.RootFolder.PathName;
    if length(s)>3 then s:=s+'\';
    if not createdir(s+'NewFolder') then
      showmessage(‘Katolog yaratib bo’lmaydydi’)
    else
      file2.Refresh;
  end;
end;

procedure TForm1.DeleteClick(Sender: TObject);
begin
  if enableF then begin
    if getR(file1.SelectedFolder.PathName)<>'' then begin
      assignfile(fromF,file1.SelectedFolder.PathName);
      {$I-}
        reset(fromF);
      {$I+}
      if ioresult=0 then begin
        closefile(fromF);
        erase(fromF);
      end
      else
        showmessage('Faylni o`chirib bo`lmaydi');
    end
    else
      if not myremovedir(file1.SelectedFolder.PathName) then
        showmessage(' Katalognini o`chirib bo`lmaydi ');
    file1.Refresh;
  end
  else begin
    if getR(file2.SelectedFolder.PathName)<>'' then begin
      assignfile(fromF,file2.SelectedFolder.PathName);
      {$I-}
        reset(fromF);
      {$I+}
      if ioresult=0 then begin
        closefile(fromF);
        erase(fromF);
      end
      else
        showmessage('Faylni o`chirib bo`lmaydi');
    end
    else
      if not myremovedir(file2.SelectedFolder.PathName) then
        showmessage(' Katalognini o`chirib bo`lmaydi’);
    file2.Refresh;
  end;
end;

procedure TForm1.File1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if (Sender as TShellListView) =File1
  then
    Accept := Source = File2
  else
    Accept := Source = File1;
end;

procedure TForm1.File1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  RePlaceClick(sender);
end;

end.

2678 marta o`qildi.