procedure mnuCalcClick(Sender: TObject);

procedure mnuNotepadClick(Sender: TObject);

procedure mnuPaintClick(Sender: TObject);

procedure mnuCPanelClick(Sender: TObject);

procedure mnuFCopyClick(Sender: TObject);

procedure mnuFDelClick(Sender: TObject);

procedure mnuFMoveClick(Sender: TObject);

procedure mnuFRenClick(Sender: TObject);

procedure btnRoot1Click(Sender: TObject);

procedure btnRoot2Click(Sender: TObject);

procedure timClockTimer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnUp1Click(Sender: TObject);

procedure btnUp2Click(Sender: TObject);

procedure dcbPanel1Change(Sender: TObject);

procedure dcbPanel2Change(Sender: TObject);

procedure slvPanel1Click(Sender: TObject);

procedure slvPanel2Click(Sender: TObject);

procedure mnuOpenClick(Sender: TObject);

procedure mnuFileCreateClick(Sender: TObject);

procedure mnuIconClick(Sender: TObject);

procedure mnuListClick(Sender: TObject);

procedure mnuTableClick(Sender: TObject);

procedure mnuSmallIconClick(Sender: TObject);

procedure mnuDirCreateClick(Sender: TObject);

procedure mnuCmdClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

var

sourcepath, receivepath, file1, file2, ext1: string;

i: integer;

shellsource, shellreceiv: TShellListView;

function CopyDir(const fromDir, toDir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_COPY;

fFlags := FOF_FILESONLY;

pFrom := PChar(fromDir + #0);

pTo := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function MoveDir(const fromDir, toDir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_MOVE;

fFlags := FOF_FILESONLY;

pFrom := PChar(fromDir + #0);

pTo := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function RenameDir(const fromDir, toDir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_RENAME;

fFlags := FOF_FILESONLY;

pFrom := PChar(fromDir + #0);

pTo := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function DelDir(dir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_DELETE;

fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_ALLOWUNDO;

pFrom := PChar(dir + #0);

end;

Result := (0 = ShFileOperation(fos));

end;

procedure TfrmMain.mnuCloseClick(Sender: TObject);

begin

close();

end;

procedure TfrmMain.mnuClockClick(Sender: TObject);

begin

mnuClock.Checked:=not mnuClock.Checked;

if mnuClock.Checked then lbClock.Visible:=true

else lbClock.Visible:=false;

end;

procedure TfrmMain.mnuDateClick(Sender: TObject);

begin

mnuDate.Checked:=not mnuDate.Checked;

if mnuDate.Checked then lbDate.Visible:=true

else lbDate.Visible:=false;

end;

procedure TfrmMain.mnuCalcClick(Sender: TObject);

begin

WinExec('calc.exe', 0);

end;

procedure TfrmMain.mnuNotepadClick(Sender: TObject);

begin

WinExec('notepad', 1);

end;

procedure TfrmMain.mnuPaintClick(Sender: TObject);

begin

winexec('mspaint.exe', 1);

end;

procedure TfrmMain.mnuCPanelClick(Sender: TObject);

begin

WinExec('control panel', 1);

end;

procedure TfrmMain.mnuFCopyClick(Sender: TObject);

begin

if shellsource.Selected=nil then exit;

if (MessageDlg('Ви дійсно бажаєте скопіювати виділені обєкти?', mtConfirmation, [mbYes,mbNo], 0) = mrNo) then exit;

for i:=0 to shellsource.Items.Count-1 do

begin

if shellsource.Items.Item[i].selected then

begin

sourcepath:=shellsource.Folders[shellsource.Items.Item[i].index]. PathName;

file1:=sourcepath;

delete(file1,1,length(shellsource.RootFolder.PathName));

receivepath:=shellreceiv.RootFolder.PathName+'\'+file1;

CopyDir(PChar(sourcepath), PChar(receivepath));

end;

end;

slvPanel1.Refresh;

slvPanel2.Refresh;

end;

procedure TfrmMain.mnuFDelClick(Sender: TObject);

begin

if shellsource.Selected=nil then exit;

if (MessageDlg('Ви дійсно бажаєте видалити виділені обєкти?', mtConfirmation, [mbYes,mbNo], 0) = mrNo) then exit;

for i:=0 to shellsource.Items.Count-1 do

begin

if shellsource.Items.Item[i].selected then

begin

sourcepath:=shellsource.Folders[shellsource.Items.Item[i].index]. PathName;

DelDir(sourcepath);

end;

end;

shellsource.Refresh;

shellreceiv.Refresh;

end;

procedure TfrmMain.mnuFMoveClick(Sender: TObject);

begin

if shellsource.Selected=nil then exit;

if (MessageDlg('Ви дійсно бажаєте перемістити виділені обєкти?', mtConfirmation, [mbYes,mbNo], 0) = mrNo) then exit;

for i:=0 to shellsource.Items.Count-1 do

begin

if shellsource.Items.Item[i].selected then

begin

sourcepath:=shellsource.Folders[shellsource.Items.Item[i].index]. PathName;

file1:=sourcepath;

delete(file1,1,length(shellsource.RootFolder.PathName));

receivepath:=shellreceiv.RootFolder.PathName+'\'+file1;

MoveDir(PChar(sourcepath), PChar(receivepath));

end;

end;

slvPanel1.Refresh;

slvPanel2.Refresh;

end;

procedure TfrmMain.mnuFRenClick(Sender: TObject);

begin

if shellsource.Selected=nil then exit;

sourcepath:=shellsource.selectedFolder.PathName;

ext1:=shellsource.selectedFolder.PathName;

delete(ext1, 1, Pos('.', ext1)-1);

file1:=InputBox('Ввід імені файла', 'Введіть нове імя файлу', '');

if shellsource.selectedFolder.IsFolder=false then

begin

if (Pos('.', file1)=0) and (file1<>'') then

begin

if MessageDlg('Ви дійсно бажаєте змінити розширення файла?', mtWarning, [mbYes, mbNo], 0) = mrNo then file1:=file1+ext1;

end;

end;

file2:=sourcepath;

delete(file2, length(shellsource.RootFolder.PathName)+1, length(sourcepath));

receivepath:=file2+'\'+file1;

RenameDir(PChar(sourcepath), PChar(receivepath));

shellsource.Refresh;

end;

procedure TfrmMain.btnRoot1Click(Sender: TObject);

begin

while slvPanel1.RootFolder.PathName<>UpCase(dcbPanel1.Drive)+':\' do slvPanel1.Back;

end;

procedure TfrmMain.btnRoot2Click(Sender: TObject);

begin

while slvPanel2.RootFolder.PathName<>UpCase(dcbPanel2.Drive)+':\' do slvPanel2.Back;

end;

procedure TfrmMain.timClockTimer(Sender: TObject);

begin

lbClock.Caption:=TimeToStr(time);

lbDate.Caption:=DateToStr(Date);

sbPanel1.Panels.Items[0].Text:=slvPanel1.RootFolder.PathName;

sbPanel2.Panels.Items[0].Text:=slvPanel2.RootFolder.PathName;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

timClock.Enabled:=true;

shellsource:=slvPanel1;

shellreceiv:=slvPanel2;

lbClock.Caption:=TimeToStr(time);

lbDate.Caption:=DateToStr(date);

end;

procedure TfrmMain.btnUp1Click(Sender: TObject);

begin

if slvPanel1.RootFolder.PathName<>UpCase(dcbPanel1.Drive)+':\' then slvPanel1.Back;

end;

procedure TfrmMain.btnUp2Click(Sender: TObject);

begin

if slvPanel2.RootFolder.PathName<>UpCase(dcbPanel2.Drive)+':\' then slvPanel2.Back;

end;

procedure TfrmMain.dcbPanel1Change(Sender: TObject);

begin

slvPanel1.Root:=dcbPanel1.Drive+':\';

end;

procedure TfrmMain.dcbPanel2Change(Sender: TObject);

begin

slvPanel2.Root:=dcbPanel2.Drive+':\';

end;

procedure TfrmMain.slvPanel1Click(Sender: TObject);

begin

shellsource:=slvPanel1;

shellreceiv:=slvPanel2;

for i:=0 to shellreceiv.Items.Count-1 do

begin

if shellreceiv.Items.Item[i].selected then shellreceiv.Items.Item[i]. selected:=false;

end;

end;

procedure TfrmMain.slvPanel2Click(Sender: TObject);

begin

shellsource:=slvPanel2;

shellreceiv:=slvPanel1;

for i:=0 to shellreceiv.Items.Count-1 do

begin

if shellreceiv.Items.Item[i].selected then shellreceiv.Items.Item[i]. selected:=false;

end;

end;

procedure TfrmMain.mnuOpenClick(Sender: TObject);

begin

if shellsource.Selected=nil then exit;

if shellsource.SelectedFolder.IsFolder=false then ShellExecute (Application.Handle, 'open', PChar(shellsource.SelectedFolder. PathName), '', '', SW_SHOWNORMAL);

shellsource.Refresh;

end;

procedure TfrmMain.mnuFileCreateClick(Sender: TObject);

begin

file1:=InputBox('Створення нового файлу', 'Введіть імя нового файлу', '');

CreateFile(PChar(shellsource.RootFolder.PathName+'\'+file1), 0, 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);

shellsource.Refresh;

end;

procedure TfrmMain.mnuIconClick(Sender: TObject);

begin

shellsource.ViewStyle:=vsIcon;

end;

procedure TfrmMain.mnuListClick(Sender: TObject);

begin

shellsource.ViewStyle:=vsList;

end;

procedure TfrmMain.mnuTableClick(Sender: TObject);

begin

shellsource.ViewStyle:=vsReport;

end;

procedure TfrmMain.mnuSmallIconClick(Sender: TObject);

begin

shellsource.ViewStyle:=vsSmallIcon;

end;

procedure TfrmMain.mnuDirCreateClick(Sender: TObject);

begin

file1:=InputBox('Створення нового каталогу', 'Введіть імя нового каталогу', '');

CreateDir(shellsource.RootFolder.PathName+'\'+file1);

shellsource.Refresh;

end;

procedure TfrmMain.mnuCmdClick(Sender: TObject);

begin

WinExec('cmd', 1);

end;

end.

Размещено на Allbest.ru