Добавил:

f24 Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Северный (Арктический) федеральный университет им. М. В. Ломоносова

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

Prilozhenie_G_Text_programmy

.docx

Скачиваний:

Добавлен:

07.08.2013

Размер:

59.8 Кб

Скачать

☆

Приложение Г

ФГБОУ ВПО «Саратовский государственный университет

имени Н.Г. Чернышевского»

Колледж радиоэлектроники имени П.Н. Яблочкова

643.КРЭ.00001-01 12 01-1

Разработка программы - оболочки файловый менеджер

Текст программы.

643.КРЭ.00001-01 12 01-1

листов 13

2012

Листинг программы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, FileCtrl, ComCtrls, ImgList, Menus, ExtCtrls,unit2,

Buttons, shellapi, xpman;

type

TForm1 = class(TForm)

ImageList1: TImageList;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

ListView1: TListView;

ListView2: TListView;

DriveComboBox1: TDriveComboBox;

DriveComboBox2: TDriveComboBox;

Label1: TLabel;

Label2: TLabel;

StatusBar1: TStatusBar;

StatusBar2: TStatusBar;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

procedure ListView2DblClick(Sender: TObject);

procedure DriveComboBox2Change(Sender: TObject);

procedure dbclicksecondtime2;

procedure dbclickfirstime2;

procedure AddNewFile2(f:TSearchRec);

procedure NewList2;

procedure Copy;

procedure FormCreate(Sender: TObject);

procedure AddNewFile(f:TSearchRec);

procedure NewList;

procedure dbclickfirstime;

procedure dbclicksecondtime;

procedure DriveComboBox1Change(Sender: TObject);

procedure ListView1DblClick(Sender: TObject);

procedure ListView1Compare(sender:TObject;Item1,Item2:TListItem;

Data:integer;var Compare:integer);

procedure N4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure N5Click(Sender: TObject);

function MyRemoveDir(sDir: String):boolean;

procedure mydelete;

procedure Button3Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure ListView1Click(Sender: TObject);

procedure ListView2Click(Sender: TObject);

procedure aftercopy1;

procedure aftercopy2;

procedure dbclickthirdtime2;

procedure dbclickthirdtime;

procedure Button2Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure newdirectory;

procedure N8Click(Sender: TObject);

procedure changeplace;

procedure N10Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure ListView1StartDrag(Sender: TObject;

var DragObject: TDragObject);

procedure ListView2DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure ListView2DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure ListView1EndDrag(Sender, Target: TObject; X, Y: Integer);

procedure ListView2StartDrag(Sender: TObject;

var DragObject: TDragObject);

procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure ListView2EndDrag(Sender, Target: TObject; X, Y: Integer);

procedure ListView1KeyPress(Sender: TObject; var Key: Char);

procedure ListView2KeyPress(Sender: TObject; var Key: Char);

procedure ListView1Editing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);

procedure ListView1Edited(Sender: TObject; Item: TListItem; var S: String);

procedure ListView2Editing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);

procedure ListView2Edited(Sender: TObject; Item: TListItem; var S: String);

procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);

procedure ListView2ColumnClick(Sender: TObject; Column: TListColumn);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

way,way2:string; lv1,lv2:boolean; oldname:string;

implementation

{$R *.dfm}

Function tform1.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;

// Процедура: TForm1.FormCreate(Sender: TObject)

// Цель: создание формы

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.FormCreate(Sender: TObject);

var NewColumn: TListColumn; i:integer;

begin

lv1:=false; lv2:=false;

way2:=drivecombobox2.drive+'://*.*'; label2.Caption:=way2;

way:=drivecombobox1.drive+'://*.*'; label1.Caption:=way;

with ListView1 do

begin

Viewstyle:=vsReport; newcolumn:=columns.Add; newcolumn.Caption:='Имя';

newcolumn:=columns.Add; newcolumn.Caption:='Размер, байт';

newcolumn:=columns.Add; newcolumn.Caption:='Дата создания';

newcolumn:=columns.Add; newcolumn.Caption:='Скрытый';

newcolumn:=columns.Add; newcolumn.Caption:='Системный';

for i:=0 to 4 do columns[i].Width:=100

end;

with ListView2 do

begin

Viewstyle:=vsReport; newcolumn:=columns.Add; newcolumn.Caption:='Имя';

newcolumn:=columns.Add; newcolumn.Caption:='Размер, байт';

newcolumn:=columns.Add; newcolumn.Caption:='Дата создания';

newcolumn:=columns.Add; newcolumn.Caption:='Скрытый';

newcolumn:=columns.Add; newcolumn.Caption:='Системный';

for i:=0 to 4 do columns[i].Width:=100

end; end;

procedure TForm1.ListView1Compare(sender:TObject;Item1,Item2:TListItem;

Data:integer;var Compare:integer);

begin

if Item1.ImageIndex=Item2.ImageIndex then compare:=0 else

if item1.imageindex<item2.imageindex then compare:=-1

else compare:=1 end;

procedure TForm1.NewList;

var f: TSearchRec; number:string;

begin

ListView1.Clear; if FindFirst(way,faAnyFile,f)<>0 then exit else

addnewfile(f); while findnext(f)=0 doaddnewfile(f); findclose(f);

ListView1.AlphaSort; if length(way)=7 then

begin

str(listview1.Items.Count,number); statusbar1.SimpleText:=' Элементов '+number

end

else begin

str(listview1.Items.Count-2,number); statusbar1.SimpleText:=' Элементов '+number end; end;

procedure TForm1.AddNewFile(f:TSearchRec);

begin

with ListView1.Items.Add, f do

begin caption:=name; if (Attr and faDirectory)<>0 then

begin ImageIndex:=0; SubItems.Add('DIR'); subItems.Add(DatetimetoStr((filedatetodatetime(time)))); end

else

begin ImageIndex:=1; SubItems.Add(inttostr(size));

subItems.Add(DatetimetoStr((filedatetodatetime(time)))); end;

if (Attr and faHidden)<>0 then SubItems.Add('äà') else SubItems.Add('íåò');

if (Attr and faSysFile)<>0 then SubItems.Add('äà') else SubItems.Add('íåò');

end; end;

procedure TForm1.dbclickfirstime;

var i,listsize:integer; way1:string;

begin

way1:=way; delete(way1,length(way1)-2,3);

way:=way1+listview1.items.item[listview1.itemindex].caption+'/*.*';

newlist; with ListView1.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview1.Items.Count-1; i:=0;

while i<=listsize do

begin with listview1.Items.Item[i] do begin if (Caption='.') or (Caption='..')

then

begin Delete; listsize:=listsize-1; i:=i-1; end; end; i:=i+1; end;

label1.Caption:=way end;

procedure TForm1.dbclicksecondtime;

var i,linesize,listsize:integer; way1:string;

begin

way1:=way; delete(way1,length(way1)-3,4); linesize:=length(way1); i:=0;

while linesize>i do

begin if way1[linesize]<>'/' then delete(way1,linesize,1) else break; linesize:=linesize-1; end;

way:=way1+'*.*';

if length(way)=7 then

begin newlist; label1.caption:=way; end else

begin newlist; with ListView1.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview1.Items.Count-1; i:=0; while i<=listsize do

begin with listview1.Items.Item[i] do begin if (Caption='.') or (Caption='..')

then begin Delete; listsize:=listsize-1; i:=i-1; end; end; i:=i+1; end; label1.Caption:=way;

end;end;

procedure TForm1.dbclickthirdtime;

var way1,fname:string; startinfo:tstartupinfo; procinfo:tprocessinformation;

begin

fillchar(startinfo,sizeof(startinfo),#0); startinfo.cb:=sizeof(startinfo);

way1:=way; delete(way1,length(way1)-2,3);

fname:=way1+listview1.items.item[listview1.itemindex].caption;

shellexecute(application.MainForm.Handle,nil,pchar(fname),'',pchar(way1),sw_show); end;

// Процедура: TForm1.DriveComboBox1Change(Sender: TObject)

// Цель: выбор пути к директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.DriveComboBox1Change(Sender: TObject);

begin way:=drivecombobox1.Drive+'://*.*'; NewList; label1.Caption:=way; end;

procedure TForm1.ListView1DblClick(Sender: TObject);

begin

try case listview1.Items.item[listview1.Itemindex].ImageIndex of

0: dbclickfirstime;

1: dbclickthirdtime;

2: dbclicksecondtime

else exit

end; except exit; end; end;

procedure TForm1.NewList2;

var f: TSearchRec; number:string;

begin

ListView2.Clear; if FindFirst(way2,faAnyFile,f)<>0 then exit else

addnewfile2(f); while findnext(f)=0 do addnewfile2(f); findclose(f);

ListView2.AlphaSort; if length(way2)=7 then

begin str(listview2.Items.Count,number); statusbar2.SimpleText:=' Элементов '+number

end

else begin

str(listview2.Items.Count-2,number);

statusbar2.SimpleText:=' Элементов '+number

end;

// Процедура: TForm1.AddNewFile2(f:TSearchRec)

// Цель: добавление нового файла в директорию

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.AddNewFile2(f:TSearchRec);

begin with ListView2.Items.Add, f do

begin caption:=name; if (Attr and faDirectory)<>0 then

begin ImageIndex:=0; SubItems.Add('DIR');

subItems.Add(DatetimetoStr((filedatetodatetime(time)))); end

else

begin

ImageIndex:=1; SubItems.Add(inttostr(size));

subItems.Add(DatetimetoStr((filedatetodatetime(time)))); end;

if (Attr and faHidden)<>0 then SubItems.Add('äà') else SubItems.Add('íåò');

if (Attr and faSysFile)<>0 then SubItems.Add('äà') else SubItems.Add('íåò'); end; end;

procedure TForm1.dbclickfirstime2;

var i,listsize:integer; way1:string;

begin

way1:=way2; delete(way1,length(way1)-2,3);

way2:=way1+listview2.items.item[listview2.itemindex].caption+'/*.*';

newlist2; with ListView2.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview2.Items.Count-1; i:=0; while i<=listsize do

begin with listview2.Items.Item[i] do begin if (Caption='.') or (Caption='..')

then begin Delete; listsize:=listsize-1; i:=i-1; end; end; i:=i+1; end;

label2.Caption:=way2 end;

procedure TForm1.dbclicksecondtime2;

var i,linesize,listsize:integer; way1:string;

begin way1:=way2; delete(way1,length(way1)-3,4); linesize:=length(way1);

while linesize>0 do begin

if way1[linesize]<>'/' then delete(way1,linesize,1) else break; linesize:=linesize-1; end;

way2:=way1+'*.*'; if length(way2)=7 then begin newlist2; label2.caption:=way2; end else

begin newlist2; with ListView2.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview2.Items.Count-1; i:=0; while i<=listsize do beginwith listview2.Items.Item[i] do begin if (Caption='.') or (Caption='..') then begin Delete; listsize:=listsize-1; i:=i-1; end; end;

i:=i+1; end; label2.Caption:=way2; end; end;

procedure TForm1.dbclickthirdtime2;

var way1,fname:string; startinfo:tstartupinfo; procinfo:tprocessinformation;

begin fillchar(startinfo,sizeof(startinfo),#0); startinfo.cb:=sizeof(startinfo);

way1:=way2; delete(way1,length(way1)-2,3);

fname:=way1+listview2.items.item[listview2.itemindex].caption;

shellexecute(application.MainForm.Handle,nil,pchar(fname),'',pchar(way1),sw_show);

end;

// Процедура: TForm1.DriveComboBox1Change(Sender: TObject)

// Цель: выбор пути к директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.DriveComboBox2Change(Sender: TObject);

begin way2:=drivecombobox2.Drive+'://*.*'; NewList2; label2.Caption:=way2; end;

procedure TForm1.ListView2DblClick(Sender: TObject);

begin try case listview2.Items.item[listview2.itemindex].ImageIndex of

0: dbclickfirstime2; 1: dbclickthirdtime2; 2: dbclicksecondtime2 else exit end; except exit; end; end;

// Процедура: TForm1.Copy

// Цель: копирование файлов директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.Copy;

var way1,way3:string;

begin way1:=way; way3:=way2; delete(way1,length(way1)-2,3); delete(way3,length(way3)-2,3);

try if (lv1=true) and (lv2=false) then

begin if fileexists(way3+listview1.Items.item[listview1.itemindex].Caption) then

begin if MessageBox(0,'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way1+listview1.Items.item[listview1.itemindex].Caption),

Pchar(way3+listview1.Items.item[listview1.itemindex].Caption),false) then

begin ShowMessage('Файл успешно скопирован!');

if length(way2)=7 then newlist2 else aftercopy1;

end else ShowMessage('Не удалось копировать файл!'); end; end else

begin if MessageBox(0,''Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin

if CopyFile(Pchar(way1+listview1.Items.item[listview1.itemindex].Caption),

Pchar(way3+listview1.Items.item[listview1.itemindex].Caption),true) then

begin ShowMessage('Файл успешно скопирован!');

if length(way2)=7 then newlist2 else aftercopy1; end

else ShowMessage('Не удалось копировать файл!'); end; end; end;

if (lv1=false)and (lv2=true) then begin

if fileexists(way1+listview2.Items.item[listview2.itemindex].Caption)=true then

begin if MessageBox(0 ,'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way3+listview2.Items.item[listview2.itemindex].Caption),

Pchar(way1+listview2.Items.item[listview2.itemindex].Caption),false) then

begin ShowMessage('Файл успешно скопирован!');

if length(way)=7 then newlist else aftercopy2 end

else ShowMessage('Не удалось копировать файл!'); end end else

begin if MessageBox(0, 'Копировать файл?','Подтвердите'',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way3+listview2.Items.item[listview2.itemindex].Caption),

Pchar(way1+listview2.Items.item[listview2.itemindex].Caption),true) then

begin ShowMessage('Файл успешно скопирован!');

if length(way)=7 then newlist else aftercopy2 end

else ShowMessage('Не удалось копировать файл!'); end; end; end except exit end; end;

procedure TForm1.N4Click(Sender: TObject);

begin form1.Close end;

procedure TForm1.Button5Click(Sender: TObject);

begin form1.Close end;

procedure TForm1.Button1Click(Sender: TObject);

begin copy; end;

procedure TForm1.N5Click(Sender: TObject);

begin copy; end;

// Процедура: TForm1.mydelete

// Цель: удаление файлов в директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.mydelete;

var way1,way3:string;

begin way1:=way; way3:=way2; delete(way1,length(way1)-2,3); delete(way3,length(way3)-2,3);

try if (lv1=true) and (lv2=false) then begin

if listview1.items.item[listview1.itemindex].imageindex=0 then

begin if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONQUESTION)=idyes then

begin if myremovedir(way1+listview1.items.item[listview1.itemindex].caption) then

begin ShowMessage('Файл успешно скопирован!!'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end;

if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2; end;

if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end;

if (length(way2)>7) and (length(way)>7) then begin newlist; newlist2; aftercopy1; aftercopy2; end end else ShowMessage('Не удалось удалить!'); end; end;

if listview1.items.item[listview1.itemindex].imageindex=1 then begin

if MessageBox(0, 'Копировать файл?','Подтвердите', MB_YESNO+MB_ICONQUESTION)=idyes then

begin if deletefile(way1+listview1.items.item[listview1.itemindex].caption) then

begin ShowMessage('Файл успешно удален!');

if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end;

if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2 end;

if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end;

if (length(way2)>7) and (length(way)>7) then begin newlist; newlist2; aftercopy1; aftercopy2;

end end else ShowMessage('Не удалось удалить!') end end; end; if (lv1=false)and (lv2=true) then

begin if listview2.items.item[listview2.itemindex].imageindex=0 then begin

if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONQUESTION)=idyes then

Begin if myremovedir(way3+listview2.items.item[listview2.itemindex].caption) then

Begin ShowMessage('Файл успешно скопирован!!');if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2;

aftercopy1; end; if (length(way2)>7) and (length(way)>7) then begin newlist; newlist2; aftercopy1; aftercopy2; end end else ShowMessage('Не удалось удалить!'); end; end;

if listview2.items.item[listview2.itemindex].imageindex=1 then begin

if MessageBox(0, 'Копировать файл?','Подтвердите', MB_YESNO+MB_ICONQUESTION)=idyes then begin if deletefile(way3+listview2.items.item[listview2.itemindex].caption) then

begin ShowMessage('Файл успешно удален!'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist;

newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist;

newlist2; aftercopy1; end; if (length(way2)>7) and (length(way)>7) then begin newlist;

newlist2; aftercopy1; aftercopy2;end end else ShowMessage('Не удалось удалить!') end end end

else exit except exit end; end;

procedure TForm1.Button3Click(Sender: TObject);

begin mydelete end;

procedure TForm1.N7Click(Sender: TObject);

begin mydelete; end;

procedure TForm1.ListView1Click(Sender: TObject);

begin lv1:=true; lv2:=false; label1.Color:=clbtnshadow; label2.Color:=clbtnface; end;

procedure TForm1.ListView2Click(Sender: TObject);

begin lv1:=false; lv2:=true; label2.Color:=clbtnshadow; label1.Color:=clbtnface; end;

procedure TForm1.aftercopy1;

var way1:string; listsize,i:integer; begin newlist2; way1:=way2; delete(way1,length(way1)-2,3);

way2:=way1+'*.*'; with ListView2.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview2.Items.Count-1; i:=0; while i<=listsize do begin with listview2.Items.Item[i] do begin if (Caption='.') or (Caption='..') then begin Delete; listsize:=listsize-1; i:=i-1; end; end;

i:=i+1; end; label2.Caption:=way2 end;

procedure TForm1.aftercopy2;

var way1:string; listsize,i:integer;

begin newlist; way1:=way; delete(way1,length(way1)-2,3); way:=way1+'*.*';

with ListView1.Items.insert(0) do begin caption:='[..]'; imageindex:=2; end;

listsize:=listview1.Items.Count-1; i:=0; while i<=listsize do begin with listview1.Items.Item[i] do begin if (Caption='.') or (Caption='..') then begin Delete; listsize:=listsize-1; i:=i-1; end; end;

i:=i+1; end; label1.Caption:=way end;

procedure TForm1.Button2Click(Sender: TObject);

begin changeplace; end;

procedure TForm1.N6Click(Sender: TObject);

begin changeplace; end;

// Процедура: TForm1.newdirectory

// Цель: создание нового каталога в директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.newdirectory;

var newdir,way1:string;

begin if (lv1=true) and(lv2=false) then begin way1:=way; delete(way1,length(way1)-2,3);

newdir:=inputbox('Новый каталог','Имя нового каталога',''); if createdir(way1+newdir) then

begin showmessage('Каталог успешно создан'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist;

newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end; if (length(way2)>7) and (length(way)>7) then begin newlist;

newlist2; aftercopy1; aftercopy2; end end else showmessage('Не удается создать каталог');

end; if (lv1=false)and(lv2=true) then begin way1:=way2; delete(way1,length(way1)-2,3);

newdir:=inputbox('Новый каталог','Имя нового каталога',''); if createdir(way1+newdir) then

begin showmessage('Каталог успешно создан'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist;

newlist2; aftercopy1; end; if (length(way2)>7) and (length(way)>7) then begin newlist;

newlist2; aftercopy1; aftercopy2; end end else showmessage('Не удается создать каталог');

end; end;

procedure TForm1.N8Click(Sender: TObject);

begin newdirectory; end;

// Процедура: TForm1.changeplace

// Цель: перемещение файла из одной директории в другую

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure TForm1.changeplace;

var way1,way3:string;

begin way1:=way; way3:=way2; delete(way1,length(way1)-2,3); delete(way3,length(way3)-2,3);

try if (lv1=true) and (lv2=false) then begin if fileexists(way3+listview1.Items.item[listview1.itemindex].Caption) then

begin if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way1+listview1.Items.item[listview1.itemindex].Caption),

Pchar(way3+listview1.Items.item[listview1.itemindex].Caption),false) then

begin

deletefile(way1+listview1.Items.item[listview1.itemindex].Caption);

ShowMessage('Файл успешно перенесен!'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist;

newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end; if (length(way2)>7) and (length(way)>7) then begin newlist;

newlist2; aftercopy1; aftercopy2; end end else ShowMessage('Не удалось перенести файл!');

end; end else begin if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way1+listview1.Items.item[listview1.itemindex].Caption),

Pchar(way3+listview1.Items.item[listview1.itemindex].Caption),true) then

begin deletefile(way1+listview1.Items.item[listview1.itemindex].Caption);

ShowMessage('Файл успешно перенесен!'); if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end; if (length(way2)=7) and (length(way)>7) then begin newlist;

newlist2; aftercopy2 end; if (length(way2)>7) and (length(way)=7) then begin newlist;

newlist2; aftercopy1; end; if (length(way2)>7) and (length(way)>7) then

begin newlist; newlist2; aftercopy1; aftercopy2; end end

else ShowMessage('Не удалось перенести файл!'); end; end; end; if (lv1=false)and (lv2=true) then

begin if fileexists(way1+listview2.Items.item[listview2.itemindex].Caption)=true then

begin if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin if CopyFile(Pchar(way3+listview2.Items.item[listview2.itemindex].Caption),

Pchar(way1+listview2.Items.item[listview2.itemindex].Caption),false) then

begin deletefile(way3+listview2.Items.item[listview2.itemindex].Caption);

ShowMessage('Файл успешно перенесен!');

if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end;

if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2 end;

if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end;

if (length(way2)>7) and (length(way)>7) then begin newlist; newlist2; aftercopy1; aftercopy2; end end else ShowMessage('Не удалось перенести файл!');

end end else begin if MessageBox(0, 'Копировать файл?','Подтвердите',

MB_YESNO+MB_ICONINFORMATION)=idyes then

begin

if CopyFile(Pchar(way3+listview2.Items.item[listview2.itemindex].Caption),

Pchar(way1+listview2.Items.item[listview2.itemindex].Caption),true) then

begin deletefile(way3+listview2.Items.item[listview2.itemindex].Caption);

ShowMessage('Файл успешно перенесен!');

if (length(way2)=7) and (length(way)=7) then begin newlist; newlist2; end;

if (length(way2)=7) and (length(way)>7) then begin newlist; newlist2; aftercopy2 end;

if (length(way2)>7) and (length(way)=7) then begin newlist; newlist2; aftercopy1; end;

if (length(way2)>7) and (length(way)>7) then begin newlist; newlist2; aftercopy1; aftercopy2; end end else ShowMessage('Не удалось перенести файл!'); end; end; end except exit end; end;

procedure TForm1.N10Click(Sender: TObject);

begin winhelp(0,'help',3,0); end;

procedure TForm1.Button4Click(Sender: TObject);

begin newdirectory; end;

procedure TForm1.N9Click(Sender: TObject);

begin aboutbox.ShowModal end;

procedure TForm1.ListView1StartDrag(Sender: TObject; var DragObject: TDragObject);

begin screen.Cursor:=crDrag; end;

procedure TForm1.ListView2DragDrop(Sender, Source: TObject; X, Y: Integer);

begin copy; end;

procedure TForm1.ListView2DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

Begin accept:=source=listview1; end;

procedure TForm1.ListView1EndDrag(Sender, Target: TObject; X, Y: Integer);

begin screen.Cursor:=crdefault; end;

procedure TForm1.ListView2StartDrag(Sender: TObject; var DragObject: TDragObject);

begin screen.Cursor:=crDrag; end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

Begin accept:=source=listview2; end;

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin copy; end;

procedure TForm1.ListView2EndDrag(Sender, Target: TObject; X, Y: Integer);

begin screen.Cursor:=crdefault; end;

procedure TForm1.ListView1KeyPress(Sender: TObject; var Key: Char);

begin case key of

chr(13): begin try case listview1.Items.item[listview1.Itemindex].ImageIndex of

0: dbclickfirstime; 1: dbclickthirdtime; 2: dbclicksecondtime

else exit end; except exit; end; end; end; end;

procedure TForm1.ListView2KeyPress(Sender: TObject; var Key: Char);

begin case key of

chr(13): begin try case listview2.Items.item[listview2.Itemindex].ImageIndex of

0: dbclickfirstime2; 1: dbclickthirdtime2; 2: dbclicksecondtime2

else exit end; except exit; end; end; end; end;

procedure TForm1.ListView1Editing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);

begin oldname:=listview1.items.item[listview1.itemindex].caption;end;

procedure TForm1.ListView1Edited(Sender: TObject; Item: TListItem; var S: String);

var oldway,newway,way1,way3:string;

begin

way1:=way; way3:=way; delete(way1,length(way1)-2,3); delete(way3,length(way3)-2,3);

oldway:=way1+oldname; newway:=way3+s; renamefile(oldway,newway); end;

procedure TForm1.ListView2Editing(Sender:TObject;Item: TListItem; var AllowEdit: Boolean);

begin oldname:=listview2.items.item[listview2.itemindex].caption; end;

procedure TForm1.ListView2Edited(Sender: TObject; Item: TListItem; var S: String);

var oldway,newway,way1,way3:string;

begin

way1:=way2; way3:=way2; delete(way1,length(way1)-2,3); delete(way3,length(way3)-2,3);

oldway:=way1+oldname; newway:=way3+s; renamefile(oldway,newway); end;

// Процедура: QuickSortListViewByInterval(var ListView:TListView; Column: integer;FirstRow:integer;LastRow:integer;TypeCol:integer)

// Цель: отсортировать каталоги в директории

// Исходные данные: нет

// Подключаемые модули: нет

// Дата создания: 10.12.12

// Автор: Одинцов А. С.

// Исправления: нет

procedure QuickSortListViewByInterval(var ListView : TListView;

Column : integer; /// Do sort by this column

FirstRow : integer; /// From this line to begin

LastRow : integer; /// On this to complete

TypeCol : integer); /// Type of data in sorted column

//1 - integer; other - string (ASC sort);

var li : TListItem; item : string; Data : pointer;

procedure switchIT(i, j : integer); var ACol : integer;

begin item := ListView.Items[i].Caption;

Data := ListView.Items[i].Data; ListView.Items[i].Caption := ListView.Items[j].Caption;

ListView.Items[j].Caption := item; ListView.Items[i].Data := ListView.Items[j].Data;

ListView.Items[j].Data := Data; for ACol := 0 to ListView.Columns.Count - 2 do

begin try item := ListView.Items[i].SubItems[ACol];

ListView.Items[i].SubItems[ACol] := ListView.Items[j].SubItems[ACol];

ListView.Items[j].SubItems[ACol] := item; except end end; end;

function GetIntegerFromRowCol(Col, Row : integer) : integer;

begin

if Col = 0 then Result := StrToIntDef(ListView.Items[Row].Caption, 0)

else Result := StrToIntDef(ListView.Items[Row].SubItems[Column-1], 0)

end;

function GetstringFromRowCol(Col, Row : integer) : string;

begin if Col = 0 then Result := ListView.Items[Row].Caption

else Result := ListView.Items[Row].SubItems[Column-1]; end;

procedure QuickSortListViewAsNumeric(L, R : integer);

var i, j : integer; key : integer;

begin repeat

i := L; j := R; key := GetIntegerFromRowCol(Column, (L + R) shr 1); repeat

while GetIntegerFromRowCol(Column, i) < key do inc(i);

while key < GetIntegerFromRowCol(Column, j) do dec(j); if i <= j then

begin

// Exchange

switchIT(i,j); inc(i); dec(j); end; until i > j;

if L < j then QuickSortListViewAsNumeric(L, j); L := i; until i >= R; end;

procedure QuickSortListViewAsstring(L, R : integer);

var i, j : integer; key : string; begin repeat

i := L; j := R; key := GetstringFromRowCol(Column, (L + R) shr 1); repeat

/ For sorting in the inverse order

/ have to change sign < on >

/ in the next two lines

while AnsiStrIComp(PChar(GetstringFromRowCol(Column, i)), PChar(key)) < 0 do inc(i);

while AnsiStrIComp(PChar(key), PChar(GetstringFromRowCol(Column, j))) < 0 do dec(j);

if i <= j then begin switchIT(i,j); inc(i); dec(j); end; until i > j;

if L < j then QuickSortListViewAsstring(L, j); L := i; until i >= R; end; begin try

Screen.Cursor := crHourGlass;

if (LastRow > ListView.Items.Count - 1) then LastRow := ListView.Items.Count - 1;

if (FirstRow < 0) then FirstRow := 0; case TypeCol of

1 : QuickSortListViewAsNumeric(FirstRow, LastRow ); else

QuickSortListViewAsstring(FirstRow, LastRow); end; finally

Screen.Cursor := crDefault; end; end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;

Column: TListColumn);

begin

QuickSortListViewByInterval (ListView1, Column.Index, 0, ListView1.Items.Count, 0);

end;

procedure TForm1.ListView2ColumnClick(Sender: TObject;

Column: TListColumn);

Begin QuickSortListViewByInterval (ListView2, Column.Index, 0, ListView2.Items.Count, 0);

end; end.

Соседние файлы в папке курсовая docx525

#
07.08.201311.92 Кб11Pravove_regulyuvannya_lizingovoyi_diyalnosti.docx
#
07.08.201313.23 Кб10Pravove_regulyuvannya_robochogo_chasu.docx
#
07.08.201357.25 Кб51Pravovoe_povedenie_kursovaya.docx
#
07.08.201321.74 Кб10Priklad_kursovaya(1).docx
#
07.08.201321.84 Кб19Priklad_kursovaya.docx
#
07.08.201359.8 Кб10Prilozhenie_G_Text_programmy.docx
#
07.08.201334.82 Кб12Primak1.docx
#
07.08.201325.77 Кб12Primernaya_tematika_kursovykh_rabot-2012_1.docx
#
07.08.201311.97 Кб10Prirodni_prava_lyudini_v_Ukrayini.docx
#
07.08.201311.73 Кб10Protsedura_impichmentu_v_Ukrayini.docx
#
07.08.201313.54 Кб10ramki_dlya_kursovogo.docx