Дипломная работа - Электронно-картографическая система SaveNavigation в системе программирования Delphi 7.0 - файл n1.doc

Дипломная работа - Электронно-картографическая система SaveNavigation в системе программирования Delphi 7.0
скачать (580.1 kb.)
Доступные файлы (5):
n1.doc893kb.23.06.2005 11:36скачать
n2.doc288kb.12.06.2005 06:43скачать
n3.db
n4.jpg22kb.12.06.2005 03:32скачать
n5.doc179kb.12.06.2005 08:09скачать

n1.doc

1   2   3   4   5   6   7   8
0 then begin

if Item.SubItems[0]<>'' then filename := filename+'.'+Item.SubItems[0];

if not copyFileTo(road+'\'+filename,road_2+'\'+filename) then showMessage('Не удалось скопировать '+filename)

end

else begin

copyDir(road+'\'+filename,road_2)

end;

Item := ListView.GetNextItem(Item, sdAll, [isSelected])

until Item = nil;

if Chesked_1Or2 = First then begin

ListViewClick(ListView2);

ShowDirectory(SecondP.road,ListView2);

ListViewClick(ListView1)

end

else begin

ListViewClick(ListView1);

ShowDirectory(FirstP.road,ListView1);

ListViewClick(ListView2)

end

end;

117 : if ((Item <> nil)and(Item.Caption<>'..'))or(ListView.SelCount>1) then begin

if Chesked_1Or2 = First then road_2 := SecondP.road

else road_2 := FirstP.road;

if InputQuery('Comander','Переместить в ...',road_2) then begin

repeat

if Item.Caption<>'..' then begin

filename := Item.Caption;

if (Item.ImageIndex<>0)and(Item.SubItems[0]<>'') then filename := filename+'.'+Item.SubItems[0];

if road[1]<>road_2[1] then

if Item.ImageIndex=0 then begin

if copyDir(road+'\'+filename,road_2) then

if not RemoveTree(road+'\'+filename) then showMessage('Hе удаётся удалить каталог '+filename)

end

else begin

if CopyFileTo(road+'\'+filename,road_2+'\'+filename) then

if not DeleteFile(road+'\'+filename) then showMessage('Hе удаётся удалить файл '+filename)

end

else

if not RenameFile(road+'\'+filename,road_2+'\'+filename) then ShowMessage('Невозможно переместить файл/каталог: '+filename)

end;

Item := ListView.GetNextItem(Item, sdAll, [isSelected])

until Item = nil;

if Chesked_1Or2 = First then begin

ShowDirectory(FirstP.road,ListView1);

Chesked_1Or2 := Second;

ShowDirectory(SecondP.road,ListView2);

Chesked_1Or2 := First

end

else begin

Chesked_1Or2 := First;

ShowDirectory(FirstP.road,ListView1);

Chesked_1Or2 := Second;

ShowDirectory(SecondP.road,ListView2)

end

end

end;

118 : if InputQuery('Comander','Новая директория',road_2) then//F7 - Созд. кат.

if ForceDirectories(road+'\'+road_2) then ShowDirectory(road,ListView)

else ShowMessage('Невозможно создать каталог(и)');

46,119 : if Item <> nil then begin //F8 - Удалить

if ListView.SelCount = 1 then begin//выделен 1 файл

if Item.Caption<>'..' then

if Item.ImageIndex = 0 then begin//папка

if Application.MessageBox(PChar('Вы Уверены,'+#13#10+'что хотите удалить каталог '+Item.Caption+'?'),'Удаление...',MB_OkCancel)=1 then

if not RemoveTree(road+'\'+Item.Caption) then ShowMessage('Hевозможно удалить каталог '+Item.Caption)

end

else begin//файл

filename := Item.Caption;

if Item.SubItems[0]<>'' then filename := filename+'.'+Item.SubItems[0];

if Application.MessageBox(PChar('Вы Уверены,'+#13#10+'что хотите удалить файл '+filename+'?'),'Удаление...',MB_OkCancel)=1 then

if not DeleteFile(road+'\'+filename) then ShowMessage('невозможно удалить файл '+filename)

end

end

else //выделено несколько файлов

if Application.MessageBox(PChar('Вы Уверены,'+#13#10+'что хотите удалить '+IntToStr(ListView.SelCount)+' файлов(а) ?'),'Удаление...',MB_OkCancel)=1 then

repeat

if Item.Caption<>'..' then

if Item.ImageIndex = 0 then begin//папка

if not RemoveTree(road+'\'+Item.Caption) then ShowMessage('Hевозможно удалить каталог '+Item.Caption)

end

else begin//файл

filename := Item.Caption;

if Item.SubItems[0]<>'' then filename := filename+'.'+Item.SubItems[0];

if not DeleteFile(road+'\'+filename) then ShowMessage('невозможно удалить файл '+filename)

end;

Item := ListView.GetNextItem(Item, sdAll, [isSelected])

until Item = nil;

showDirectory(road,ListView)

end //Удалить заканчивается

end{case}

end

end{case}

end;
procedure TForm1.ListViewClick(Sender: TObject);

begin

if Sender = ListView1 then begin

ListView2.Color := clScrollBar;

ListView1.Color := clWindow;

Chesked_1Or2 := First

end

else begin

ListView1.Color := clScrollBar;

ListView2.Color := clWindow;

Chesked_1Or2 := Second

end

end;
procedure TForm1.ListView0DblClick(var road : string; var ListView: TListView);

var i : integer; Item : TListItem;

begin

if ListView.Items[ListView.ItemIndex].ImageIndex = 0 then {directory}

if ListView.Items[ListView.ItemIndex].Caption = '..' then begin

i := length(road);

while road[i]<>'\' do dec(i);

road := copy(road,1,i-1);

ShowDirectory(road,ListView)

end

else begin

road := road+'\'+ListView.Items[ListView.ItemIndex].Caption;

ShowDirectory(road,ListView)

end

else begin{Любой файл}

Item := ListView.Items[ListView.ItemIndex];

with Item do

while Item<>nil do begin

if (SubItems[0] = 'exe')or(SubItems[0] = 'bat')or(SubItems[0] = 'com') then

MyWinExec(road+'\'+Caption+'.'+SubItems[0])

else

if (SubItems[0] = 'txt')or(SubItems[0] = 'log')or(SubItems[0] = 'ini')or(SubItems[0] = 'doc') then

MyWinExec('C:\WINDOWS\NOTEPAD.EXE '+road+'\'+Caption+'.'+SubItems[0])

else

if (SubItems[0] = 'bmp')or(SubItems[0] = 'jpg') then

MyWinExec('C:\WINDOWS\pbrush.EXE '+road+'\'+Caption+'.'+SubItems[0])

else

if (SubItems[0] = 'gif')or(SubItems[0] = 'jpeg')or(SubItems[0] = 'htm')or(SubItems[0] = 'html') then

MyWinExec('C:\Program Files\Internet Explorer\IEXPLORE.EXE '+road+'\'+Caption+'.'+SubItems[0])

else begin

OpenDialog1.Filter := 'Приложения (*.ехе)|*.exe';

OpenDialog1.InitialDir := 'C:\Windows';

OpenDialog1.Title := 'Файл '+Caption+'.'+SubItems[0]+' открыть с помощью...';

if OpenDialog1.Execute then

if SubItems[0] = '' then

MyWinExec(OpenDialog1.FileName+' '+road+'\'+Caption)

else

MyWinExec(OpenDialog1.FileName+' '+road+'\'+Caption+'.'+SubItems[0])

end;

Item := ListView.GetNextItem(Item, sdAll, [isSelected])

end

end

end;
procedure TForm1.ListViewCompare(Sender: TObject; Item1, Item2: TListItem;

Data: Integer; var Compare: Integer);

begin

if Sender = ListView1 then ListView0Compare(Item1, Item2, Compare, FirstP.numSort)

else ListView0Compare(Item1, Item2, Compare, SecondP.numSort)

end;
procedure TForm1.ListViewColumnClick(Sender: TObject;

Column: TListColumn);

begin

if Sender = ListView1 then begin

if Column.Caption = 'Название' then FirstP.numSort := 0

else

if Column.Caption = 'Расш.' then FirstP.numSort := 1

else

if Column.Caption = 'Размер, б' then FirstP.numSort := 2

else

if Column.Caption = 'Дата создания' then FirstP.numSort := 3

else

if Column.Caption = 'Скрытый' then FirstP.numSort := 4

else FirstP.numSort := 5;

ListView1.AlphaSort

end

else begin

if Column.Caption = 'Название' then SecondP.numSort := 0

else

if Column.Caption = 'Расш.' then SecondP.numSort := 1

else

if Column.Caption = 'Размер, б' then SecondP.numSort := 2

else

if Column.Caption = 'Дата создания' then SecondP.numSort := 3

else

if Column.Caption = 'Скрытый' then SecondP.numSort := 4

else SecondP.numSort := 5;

ListView2.AlphaSort

end

end;
procedure TForm1.ListViewDblClick(Sender: TObject);

begin

if Sender = ListView1 then begin

if ListView1.ItemIndex >= 0 then ListView0DblClick(FirstP.road,ListView1)

end

else begin

if ListView2.ItemIndex >= 0 then ListView0DblClick(SecondP.road,ListView2)

end

end;
procedure TForm1.ComboBoxDropDown(Sender: TObject);

var disk : char;

ComboBox : TComboBox;

begin

if Sender = ComboBox1 then ComboBox := ComboBox1

else ComboBox := ComboBox2;

ComboBox.Clear;

try

if DirectoryExists('A:') then ComboBox.AddItem('A:',nil);

if DirectoryExists('B:') then ComboBox.AddItem('B:',nil);

for disk := 'C' to 'Z' do

if DirectoryExists(disk+':') then ComboBox.AddItem(disk+':',nil)

finally

end

{disk := 'C';

while DirectoryExists(disk+':') do begin

ComboBox.AddItem(disk+':',nil);

inc(Byte(disk))

end}

end;
procedure TForm1.ComboBoxCloseUp(Sender: TObject);

begin

if Sender = ComboBox1 then begin

ListViewClick(ListView1);

if ComboBox1.Items[ComboBox1.Itemindex] <> '' then FirstP.road := ComboBox1.Items[ComboBox1.Itemindex];

ShowDirectory(FirstP.road,ListView1)

end

else begin

ListViewClick(ListView2);

if ComboBox2.Items[ComboBox2.Itemindex] <> '' then SecondP.road := ComboBox2.Items[ComboBox2.Itemindex];

ShowDirectory(SecondP.road,ListView2)

end

end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var p : TPoint;

begin

if Button = mbRight then begin

p := GetClientOrigin;

if Sender is TListView then PopupMenu1.Items[0].Enabled := True

else PopupMenu1.Items[0].Enabled := False;

PopupMenu1.Popup(p.X+X,p.Y+Y)

end;

end;
function InputD(Namef : string) : boolean;

var

Form : TForm;

Prompt: TLabel;

CheckBox : array [0..3] of TCheckBox;

ButtonOk,ButtonCansel : TButton;

i,attr : integer;

begin

result := false;

Form := TForm.Create(Application);

attr := FileGetAttr(Namef);

with Form do

try

Canvas.Font := Font; BorderStyle := bsDialog;

Caption := 'Свойства'; ClientWidth := 250;

ClientHeight := 150; Position := poScreenCenter;

Prompt := TLabel.Create(Form);

with Prompt do begin

Parent := Form;

Constraints.MaxWidth := form.Width;

Caption := ExtractFileName(Namef);

Left := (Form.Width - Prompt.Width) shr 1;

Top := 1

end;

for i := 0 to 3 do begin

CheckBox[i] := TCheckBox.Create(Form);

with CheckBox[i] do begin

Parent := Form; Left := 5; Top := 20+i*20

end

end;

CheckBox[0].Caption := 'Только чтение';

CheckBox[1].Caption := 'Скрытый';

CheckBox[2].Caption := 'Системный';

CheckBox[3].Caption := 'Архивный';

ButtonOk := TButton.Create(Form);

with ButtonOk do begin

Parent := Form;

Caption := 'Ok';

ModalResult := mrOk;

Default := True;

SetBounds(35,form.Height-60,75,25)

end;

ButtonCansel := TButton.Create(Form);

with ButtonCansel do begin

Parent := Form;

Caption := 'Cansel';

ModalResult := mrCancel;

Cancel := True;

SetBounds(form.Width-110,form.Height-60,75,25)

end;

if attr and faReadOnly <> 0 then CheckBox[0].Checked := true;

if attr and faHidden <> 0 then CheckBox[1].Checked := true;

if attr and faSysFile <> 0 then CheckBox[2].Checked := true;

if attr and faArchive <> 0 then CheckBox[3].Checked := true;

if ShowModal = mrOk then begin

if CheckBox[0].Checked then attr := attr or faReadOnly

else attr := attr and not faReadOnly;

if CheckBox[1].Checked then attr := attr or faHidden

else attr := attr and not faHidden;

if CheckBox[2].Checked then attr := attr or faSysFile

else attr := attr and not faSysFile;

if CheckBox[3].Checked then attr := attr or faArchive

else attr := attr and not faArchive;

if FileSetAttr(Namef,attr) = 0 then Result := True

end;

finally

Form.Free

end

end;
procedure TForm1.CharacteristicClick(Sender: TObject);

var ListView : TListView;

filename : string;

begin

if Chesked_1Or2 = First then begin

filename := FirstP.road;

ListView := ListView1

end

else begin

filename := SecondP.road;

ListView := ListView2

end;

if (ListView.SelCount<>0)and(ListView.Items[ListView.ItemIndex].Caption<>'..') then begin

filename := filename+'\'+ListView.Items[ListView.ItemIndex].Caption;

if ListView.Items[ListView.ItemIndex].ImageIndex<>0 then

if ListView.Items[ListView.ItemIndex].SubItems[0]<>'' then filename := filename+'.'+ListView.Items[ListView.ItemIndex].SubItems[0];

InputD(filename)

end

end;
procedure TForm1.GoOutClick(Sender: TObject);

begin

if CloseQuery then Close

end;
procedure TForm1.ListViewMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Sender = ListView1 then FormMouseUp(Sender,Button,Shift,X,Y+ListView1.Top)

else FormMouseUp(Sender,Button,Shift,X+ListView2.Left,Y+ListView2.Top)

end;
procedure TForm1.MenuF2Click(Sender: TObject);

var Key : word;

begin

Key := 113;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF3Click(Sender: TObject);

var Key : word;

begin

Key := 114;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF4Click(Sender: TObject);

var Key : word;

begin

Key := 115;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF5Click(Sender: TObject);

var Key : word;

begin

Key := 116;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF6Click(Sender: TObject);

var Key : word;

begin

Key := 117;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF7Click(Sender: TObject);

var Key : word;

begin

Key := 118;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuF8Click(Sender: TObject);

var Key : word;

begin

Key := 119;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.MenuSelectAllClick(Sender: TObject);

begin

if Chesked_1Or2 = First then ListView1.SelectAll

else ListView2.SelectAll

end;
procedure TForm1.MenuSelectInvertClick(Sender: TObject);

var ListView : TListView;

Item : TListItem;

begin

if Chesked_1Or2 = First then ListView := ListView1

else ListView := ListView2;

Item := ListView.Items[0];

while Item <> nil do begin

Item.Selected := not Item.Selected;

Item := ListView.GetNextItem(Item, sdAll, [isNone])

end

end;
procedure TForm1.MenuMemoryClick(Sender: TObject);

var Status : TMemoryStatus;

Form : TForm;

Labels: array [0..6] of TLabel;

Button : TButton;

i : integer;

begin

Status.dwLength := sizeof(TMemoryStatus);

GlobalMemoryStatus(Status);

Form := TForm.Create(Application);

with Form do

try

Canvas.Font := Font;

BorderStyle := bsDialog;

Caption := 'Вся Память';

ClientWidth := 350;

ClientHeight := 180;

Position := poScreenCenter;

for i := 0 to 6 do begin

Labels[i] := TLabel.Create(Form);

with Labels[i] do begin

Parent := Form;

Top := 5 + i*20

end

end;

labels[0].Caption := 'Количество используемой памяти в процентах (%) '+IntToStr(Status.dwMemoryLoad);

labels[1].Caption := 'Общее количество физической памяти '+IntToStr(Status.dwTotalPhys shr 10)+' Кб';

labels[2].Caption := 'Количество оставшейся физической памяти '+IntToStr(Status.dwAvailPhys shr 10)+' Кб';

labels[3].Caption := 'Объём страничного файла '+IntToStr(Status.dwTotalPageFile shr 10)+' Кб'#13#10;

labels[4].Caption := 'Свободного места в страничном файле '+IntToStr(Status.dwAvailPageFile shr 10)+' Кб';

labels[5].Caption := 'Общий объём виртуальной памяти '+IntToStr(Status.dwTotalVirtual shr 10)+' Кб';

labels[6].Caption := 'Количество свободной виртуальной памяти '+IntToStr(Status.dwAvailVirtual shr 10)+' Кб.';

for i := 0 to 6 do labels[i].Left := (Form.Width - Labels[i].Width) shr 1;

Button := TButton.Create(Form);

with Button do begin

Parent := Form;

Caption := 'Ok';

ModalResult := mrOk;

Default := True;

SetBounds((form.Width-Button.Width) shr 1,form.Height-60,75,25)

end;

ShowModal

finally

Form.Free

end

end;
procedure TForm1.MenuWorkWindowsClick(Sender: TObject);

begin

ShowMessage('Windows уже работает'+ FormatDateTime(' h "ч." n "м." s "с."',GetTickCount/86400000))

end;
procedure TForm1.MenuCascadnoClick(Sender: TObject);

begin

MyWinExec('rundll32 user,cascadechildwindows')

end;
procedure TForm1.MenuSvernutOknaClick(Sender: TObject);

begin

MyWinExec('rundll32 user,tilechildwindows')

end;
procedure TForm1.MenuUpdateDesctopClick(Sender: TObject);

begin

MyWinExec('rundll32 user,repaintscreen')

end;
procedure TForm1.MenuRebootExsplorerClick(Sender: TObject);

begin

MyWinExec('rundll32 shell,shellexecute Explorer')

end;
procedure TForm1.MenuControlPanelClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,Control_RunDLL')

end;
procedure TForm1.MenuDisplayPropertiesClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,Control_RunDLL desk.cpl')

end;
procedure TForm1.MenuCopyDiskAClick(Sender: TObject);

begin

MyWinExec('rundll32 diskcopy,DiskCopyRunDll')

end;
procedure TForm1.MenuFormatAClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,SHFormatDrive')

end;
procedure TForm1.MenuBistroExitWindowsClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,SHExitWindowsEx 2')

end;
procedure TForm1.MenuCloseSeansClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,SHExitWindowsEx 0')

end;
procedure TForm1.MenuPowerOffClick(Sender: TObject);

begin

MyWinExec('rundll32 shell32,SHExitWindowsEx 1')

end;
procedure TForm1.MenuHelpClick(Sender: TObject);

var Key : word;

begin

Key := 112;

ListViewKeyDown(Sender,Key,[ssLeft])

end;
procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

if Chesked_1Or2 = First then showDirectory(FirstP.road,ListView1)

else showDirectory(SecondP.road,ListView2)

end;
procedure TForm1.Memo1DblClick(Sender: TObject);

begin

Memo1.Clear;

Memo1.Lines.Append('Ничего не найдено.');

Memo1.ShowHint := false;

Memo1.Hide

end;
end.
program WinSock_Server;

{$APPTYPE CONSOLE}

uses

SysUtils,

Winsock,

Windows,

dialogs;
var

vWSAData : TWSAData;

vListenSocket,vSocket : TSocket;

vSockAddr : TSockAddr;

trId : THandle;

const

cPort = word(33);

cSigExit = 'q';

procedure SocketThread;

var SockName : TSockAddr;

aBuf : array of char;

vBuf : string;

vSize : integer;

s :TSocket;

BufSize : integer;
f: text;
begin

s := vSocket;

if s = INVALID_SOCKET then exit;

vSize := SizeOf(TSockAddr);

getpeername(s, SockName, vSize);

Writeln(format('Client accepted, remote address [%s].',[inet_ntoa (SockName.sin_addr)]));

vSize := sizeOf(BufSize);

getsockopt(s,SOL_SOCKET,SO_RCVBUF,PChar(@BufSize),vSize);

writeln(format('Receive buffer size [%d]',[BufSize]));

SetLength(aBuf,BufSize);
assignfile(f,'2.txt');

rewrite(f);
repeat

vSize := recv(s,aBuf[0],BufSize,0);

if vSize<=0 then Break;

SetLength(vBuf,vSize);

lstrcpyn(@vBuf[1],@aBuf[0],vSize);

write(f,vBuf);
writeln(format('Received from cleint: %s',[vBuf]));

until vBuf = 'q';

Writeln(format('Client disconnected, remote address [%s].',[inet_ntoa(SockName.sin_addr)]));

SetLength(aBuf,0);

closesocket(s);

closefile(f);

end;
begin

Writeln('Starting application...');

if WSAStartup($101,vWSAData)<>0 then Halt(1);

Writeln('Using Windows Sockets.');

vListenSocket := socket(AF_INET,SOCK_STREAM,IPPROTO_IP);

Writeln(format('Creating socket on port [%d].',[cPort]));

if vListenSocket = INVALID_SOCKET then Halt(1);

FillChar(vSockAddr,SizeOf(TSockAddr),0);

vSockAddr.sin_family := AF_INET;

vSockAddr.sin_port := htons(cPort);

vSockAddr.sin_addr.S_addr := INADDR_ANY;

Writeln('Binding socket...');

if bind(vListenSocket,vSockAddr,SizeOf(TSockAddr)) <> 0

then Halt(1);

if listen(vListenSocket,SOMAXCONN) <> 0

then Halt(1);

Writeln('Socket status: listening.');

repeat

vSocket := accept(vListenSocket,nil,nil);

CreateThread(nil,0,@SocketThread,0,0,trId);

until false;

closesocket(vListenSocket);

WSACleanup;

end.
program WinSockC;

{$APPTYPE CONSOLE}
uses

SysUtils,

winsock,

dialogs;
const

cPort = 33;
var

vWSAData : TWSAData;

vSocket : TSocket;

vSockAddr : TSockAddr;
F: file;

NumRead : integer;

buf : array[1..2048] of Char;
begin

if WSAStartup($101,vWSAData)<>0 then Halt(1);

vSocket := socket(AF_INET,SOCK_STREAM,IPPROTO_IP);

if vSocket = INVALID_SOCKET then Halt(1);

FillChar(vSockAddr,SizeOf(TSockAddr),0);

vSockAddr.sin_family := AF_INET;

vSockAddr.sin_port := htons(cPort);

vSockAddr.sin_addr.S_addr := inet_addr('127.0.0.1');

if connect(vSocket,vSockAddr,SizeOf(TSockAddr)) = SOCKET_ERROR then Halt(1);
AssignFile(f,'1.txt');

reset(f,1);
repeat

BlockRead(f, Buf, SizeOf(Buf), NumRead);
if send(vSocket,buf[1],Length(buf)+1,0) = SOCKET_ERROR then Break;

until EOF(f);

closesocket(vSocket);

WSACleanup;

end.
1   2   3   4   5   6   7   8


Учебный материал
© nashaucheba.ru
При копировании укажите ссылку.
обратиться к администрации