Электронно-картографическая система спутниковой связи в судовождении

5.5 Мероприятия по обеспечению безопасности в чрезвычайных ситуациях

5.5.1 Чрезвычайные ситуации наиболее вероятные для рабочего корпуса

При проектировании мероприятий по обеспечению безопасности жизнедеятельности сотрудников необходимо учитывать возможность возникновения чрезвычайной ситуации (ЧС). Для рабочего корпуса можно выделить следующие наиболее вероятные ЧС:

1) пожар, из-за нарушении мер пожарной безопасности, в результате разрядов молнии, неисправности электропроводки, самовозгорания и др. причин;

2) эпидемии респираторных заболеваний, передающихся воздушно-капельным путем, из-за большого скопления людей;

3) угроза террактов (заложенные взрывные устройства);

4) химическое заражение вследствие аварии на предприятиях города.

Рассмотрим более подробно чрезвычайную ситуацию -- пожар. Проанализируем возможные причины возникновения пожара и мероприятия по обеспечению пожарной безопасности.

5.5.2 Общие положения пожарной безопасности

В соответствии с ГОСТ 12.1.004-91 пожарная безопасность объекта должна обеспечиваться системами предотвращения пожара и противопожарной защиты, в том числе организационно-техническими мероприятиями.

Все системы пожарной безопасности должны характеризоваться уровнем обеспечения пожарной безопасности людей и материальных ценностей и выполнять одну из следующих задач:

1) исключать возникновение пожара;

2) обеспечивать пожарную безопасность людей;

3) обеспечивать пожарную безопасность материальных ценностей;

4) обеспечивать пожарную безопасность людей и материальных ценностей одновременно.

Данная система направлена на предотвращение воздействия на людей опасных факторов пожара и их вторичных проявлений.

Причинами пожара в кабинете рабочего корпуса может быть следующее:

1) нарушение изоляции проводов в электропроводке;

2) курение в помещении;

3) неисправность электрооборудования (в том числе компьютеров).

4) использование электрических кипятильников;

Таким образом, опасными факторами пожара, воздействующими на людей и материальные ценности являются:

1) пламя и искры;

2) повышенная температура окружающей среды;

3) дым.

К вторичным проявлениям опасных факторов относятся:

1) осколки, части разрушившегося оборудования, конструкций;

2) токсичные продукты горения и вещества, вышедшие из разрушенного оборудования;

3) электрический ток, возникший в результате выноса высокого напряжения на токопроводящие части оборудования.

5.5.3 Классификация помещения по пожарной безопасности

В соответствии с СНиП 21-01-97 пожарно-техническая классификация предназначается для установления необходимых требований по противопожарной защите конструкций, помещений в зависимости от их огнестойкости и (или) пожарной опасности.

Здания подразделяются по степеням огнестойкости, классам конструктивной и функциональной опасности. Степень огнестойкости здания определяется огнестойкостью его строительных конструкций. Предел огнестойкости строительных конструкций составляет не менее:

1) несущие элементы имеют потери несущей способности R не менее 45мин;

2) наружные стены теряют несущую способность R и целостность E не менее чем через 15 мин;

3) междуэтажные перекрытия характеризуются величиной RE 45мин и потерей теплоизолирующей способности I не менее 45 мин;

4) внутренние стены лестничных клеток характеризуются величиной REI 90 мин;

5) марши и площадки лестниц - R 45 мин.

Класс конструктивной пожарной опасности здания определяется степенью участия строительных конструкций в развитии пожара и образовании его опасных факторов. Класс конструктивной пожарной опасности главного корпуса -- C1, т.е. класс пожарной опасности его строительных конструкций не ниже:

1) несущие стержневые элементы (колонны, фермы) имеют класс К1 - малопожароопасные;

2) наружные стены с внешней стороны - К2 - умереннопожароопасные;

3) стены, перекрытия, перегородки имеют класс К1;

4) стены лестничных клеток и марши лестниц характеризуются классом К0 - непожароопасные.

По функциональной пожарной опасности здания подразделяются на классы в зависимости от способа их использования и от того, в какой мере безопасность людей в них в случае возникновения пожара находится под угрозой. Кабинет 512, в соответствии с СНиП 21-01-97, относится к классу Ф4.3, т.к. она используется в течение суток некоторое время и в ней находится постоянный, привыкший к местным условиям состав людей.

5.5.4 Обеспечение пожарной безопасности персонала

Для прекращения горения применяют следующие способы:

1) охлаждение зоны реакции или самих горящих веществ;

2) разбавление реагирующих веществ;

3) химическое торможение реакции сгорания;

4) изоляция реагирующих веществ от зоны сгорания.

Необходимо учитывать, что возможно возгорание компьютера или другого электрооборудования. Если горящий компьютер не отключен и находится под напряжением, то его тушение представляет опасность поражения электрическим током.

При обнаружении возникновения пожара или срабатывания пожарной сигнализации необходимо предпринять следующие действия:

1) вызвать пожарную службу по телефону 911;

2) приступить к эвакуации людей из помещений корпуса согласно схеме эвакуации;

3) немедленно открыть все выходы;

4) немедленно отключить электропитание, все электропитающие устройства;

5) дежурной пожарной команде (ДПК) приступить к тушению пожара, применяя огнетушители, водяной гидрант, песок и другие средства пожаротушения.

Эвакуация, в соответствии с СНиП 21-01-97, определяется как процесс организованного самостоятельного движения людей наружу из помещений, в которых имеется возможность воздействия на них опасных факторов пожара и осуществляется по путям эвакуации через эвакуационные выходы. Эвакуационные пути в пределах помещения должны обеспечивать безопасную эвакуацию людей через выходы из данного помещения без учета применяемых в нем средств пожаротушения и противодымной защиты.

Список использованной литературы

1.ГОСТ 12.0.003-74 ССБТ Опасные и вредные производственные факторы. Классификация;

2.Государственная система санитарно-эпидемиологического нормирования Российской Федерации. 2.2. Гигиена труда. Гигиенические критерии оценки условий труда по показателям вредности и опасности факторов производственной среды, тяжести и напряженности трудового процесса. Утв. 12.07.94. Р 2.2.0 13-94. Охрана труда и социальное страхование;

3.СанПиН 2.2.2.542-96 Гигиенические требования к видеодисплейным терминалам, персональным электронно-вычислительным машинам и организации работы;

4.Амарина Е.Е. Учет в Интернет-магазине. // www.consalting.ru, 2003;

5.Афонин С. Современные технологии по созданию сайтов и интернет-магазинов. // www.mags.ru, 2004;

6.Беляев В. Зарубежные информационные и аналитические ресурсы в сети Интернет. // Рынок ценных бумаг. - 1999. № 7, с. 26;

7.Бурдинский А. Перспективы развития рынка финансовых Интернет-услуг. // www.osp.ru, 2000;

8.Бурмистров А. Золотая лихорадка русского Интернета. // www.osp.ru, 2000;

9.Вайнман Л., Вайнман В. Динамический HTML. Руководство разработчика Web-сайтов. - Киев.: Диасофт, 2001. - 464 с.;

10.Вартанян М. SET- не догма., М.: Мир Интернет, 1999. - 254 с.;

11.Гайкович В., Першин А. Безопасность электронных банковских систем. - М.: Единая Европа, 2002. - 264 c.;

12.Гилстер П. Новый навигатор Internet. - Киев: Диалектика, 2003. - 495 c.;

13.Гофман В.Э., Хомоненко А.Д. Delphi 6. - СПб.: БХВ-Петербург, 2002. - 1152 с.;

14.Гудман Д. JavaScript. Библия пользователя. - М.: Вильямс, - Изд. 4-е, 2002. - 960 с.;

15.ДиалогСибирь // www.dialog-it.ru/ecommerce/, 2004;

16.Дмитриева М.В. Самоучитель JavaScript. - СПб.: БХВ-Петербург, 2001. - 512 с.;

17.Долгов В., Интернет-магазин OZON лидер электронной коммерции сегмента B2C в России. // www.rocit.ru, 2003;

18.Егорова Е. Интернет-магазины: взгляд изнутри. // www.cnt.online.ru, 2001;

19.Игер Б. Работа в Internet / Под ред. А. Тихонова; Пер. c англ. - М.: БИНОМ, 2001. - 313 c.;

20.Ильин М. MySQL. // www.infocity.kiev.ua, 2003;

21.Кент П. Internet / Перевод c английского В.Л. Григорьева. - М.: Компьютер, ЮНИТИ, 2003. - 267 c.;

22.Колесников О.Э. Интернет для делового человека. - M.: МЦФ, 2001. - 281 c.;

23.Костарев А.Ф. PHP в Web-дизайне. - СПб.: БХВ-Петербург, 2002. - 592 с.;

24.Котеров Д.В. Самоучитель PHP 4. - СПб.: БХВ-Петербург, 2003. - 576 с.;

25.Кривопалов Д.В. Консультации для успешного бизнеса. Интернет-магазины. // www.consalting.ru, 2003;

26.Крол Эд. Все об Internet: Руководство и каталог / Перевод c английского С.М. Тимачева. - Киев: BNV, 2003. 591 c.;

27.Левин В.К. Защита информации в информационно-вычислительных системах и сетях // Программирование. - 2002. № 5, с. 5;

28.Мацяшек Л.А. Анализ требований и проектирование систем. Разработка информационных систем с использованием UML. - М.: Вильямс, 2002. - 432 с.;

29.Методические указания по дипломному проектированию для МГСУ, специальности "Автоматизированные системы обработки информации и управления" 220200. М., 2002. - 76 с.;

30.Новомлинский Л. Электронная коммерция. Решения компании TopS. // www.topsbi.ru, 1998;

31.Нольден М. Ваш первый выход в Internet: Для начинающих пользователей Internet и широкого круга пользователей PC / Под ред. Е.В.Кондукова; Перевод с немецкого К.А. Шиндер. - Спб.: ИКС, 2002. - 238 с.;

32.Рейлли Б. Эскиз электронного магазина. // www.osp.ru, 2000;

33.Стерн М., Монти Г., Бэчман В. Сети предприятий на основе Windows NT. - СПб.: Питер, 1999. - 448 с.;

34.Томсон Л., Веллинг Л. Разработка Web-приложений на PHP и MySQL. - СПб.: ДиасофтЮП, 2003. - 672 с.;

35.Фролов А.В., Фролов Г.В. Глобальные сети компьютеров. Практическое введение в Internet, E-mail, FTP, WWW, и HTML, программирование для Windiws Sockets. - М.: Диалог - МИФИ, 2003. - 283 c.;

36.Хансен Г., Хансен Д. Базы данных: разработка и управление. - М.: Бином, 2000. - 525 c.;

37.Хоникат Д. Internet Windows 2000: Руководство пользователя / Перевод с английского В.М. Неклюдовой. - М.: БИНОМ, 2003. - 334 с.;

38.Cheswick W.R., Bellovin S.M. Firewalls and Internet Security: Repelling the Wily Hacker. - Addison-Wesley, 2002. - 275 c.;

39.An Introduction to Computer Security: The NIST Handbook. Draft. - National Institute of Standards and Technology, Technology Administration, U.S. Department of Commerce, 2001. - 310 c.;

40.E-Commerce.ru, Программный комплекс управления Интернет-магазином. // www.e-commerce.ru, 2003.

Приложения

unit Unit1;

interface

uses

Windows, SysUtils, Graphics, Classes, Controls, Forms,

Dialogs, ImgList, IdGlobal, Menus, ComCtrls, StdCtrls, Buttons,

Masks;

type

First_Or_Second = (First, Second);

TwoPanels = record

road : string;

nDir,nfiles : integer;

fkbyte : integer;

numSort : byte

end;

TForm1 = class(TForm)

ListView1: TListView;

Edit1: TEdit;

ListView2: TListView;

ComboBox1: TComboBox;

ComboBox2: TComboBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

StatusBar1: TStatusBar;

ImageList1: TImageList;

OpenDialog1: TOpenDialog;

PopupMenu1: TPopupMenu;

Characteristic: TMenuItem;

PopupRazd: TMenuItem;

GoOut: TMenuItem;

MainMenu1: TMainMenu;

MenuFile: TMenuItem;

MenuAttr: TMenuItem;

Razd1: TMenuItem;

MenuF2: TMenuItem;

MenuF3: TMenuItem;

MenuF4: TMenuItem;

MenuF5: TMenuItem;

MenuF6: TMenuItem;

MenuF7: TMenuItem;

MenuF8: TMenuItem;

Razd2: TMenuItem;

MenuExit: TMenuItem;

MenuSelect: TMenuItem;

MenuSelectAll: TMenuItem;

MenuSelectInvert: TMenuItem;

MenuComand: TMenuItem;

MenuMemory: TMenuItem;

MenuWorkWindows: TMenuItem;

Razd3: TMenuItem;

MenuCascadno: TMenuItem;

MenuSvernutOkna: TMenuItem;

MenuUpdateDesctop: TMenuItem;

MenuRebootExsplorer: TMenuItem;

Razd4: TMenuItem;

MenuControlPanel: TMenuItem;

MenuDisplayProperties: TMenuItem;

Razd5: TMenuItem;

MenuCopyDiskA: TMenuItem;

MenuFormatA: TMenuItem;

Razd6: TMenuItem;

MenuBistroExitWindows: TMenuItem;

MenuCloseSeans: TMenuItem;

MenuPowerOff: TMenuItem;

MenuHelp: TMenuItem;

SpeedButton1: TSpeedButton;

Label5: TLabel;

Label6: TLabel;

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

procedure AddNewFile(F : TSearchRec; var ListView: TListView);

procedure ShowDirectory(road : string; var ListView: TListView);

procedure ListView0Compare(Item1, Item2: TListItem; var Compare: Integer; n : byte);

procedure Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure ListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure ListViewClick(Sender: TObject);

procedure ListView0DblClick(var road : string; var ListView: TListView);

procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem;

Data: Integer; var Compare: Integer);

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

procedure ListViewDblClick(Sender: TObject);

procedure ComboBoxDropDown(Sender: TObject);

procedure ComboBoxCloseUp(Sender: TObject);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure CharacteristicClick(Sender: TObject);

procedure GoOutClick(Sender: TObject);

procedure ListViewMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure MenuF2Click(Sender: TObject);

procedure MenuF3Click(Sender: TObject);

procedure MenuF4Click(Sender: TObject);

procedure MenuF5Click(Sender: TObject);

procedure MenuF6Click(Sender: TObject);

procedure MenuF7Click(Sender: TObject);

procedure MenuF8Click(Sender: TObject);

procedure MenuSelectAllClick(Sender: TObject);

procedure MenuSelectInvertClick(Sender: TObject);

procedure MenuMemoryClick(Sender: TObject);

procedure MenuWorkWindowsClick(Sender: TObject);

procedure MenuCascadnoClick(Sender: TObject);

procedure MenuSvernutOknaClick(Sender: TObject);

procedure MenuUpdateDesctopClick(Sender: TObject);

procedure MenuRebootExsplorerClick(Sender: TObject);

procedure MenuControlPanelClick(Sender: TObject);

procedure MenuDisplayPropertiesClick(Sender: TObject);

procedure MenuCopyDiskAClick(Sender: TObject);

procedure MenuFormatAClick(Sender: TObject);

procedure MenuBistroExitWindowsClick(Sender: TObject);

procedure MenuCloseSeansClick(Sender: TObject);

procedure MenuPowerOffClick(Sender: TObject);

procedure MenuHelpClick(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure Memo1DblClick(Sender: TObject);

end;

var

Form1: TForm1;

Chesked_1Or2 : First_Or_Second;

FirstP, SecondP : TwoPanels;

implementation

{$R *.dfm}

procedure FindFiles(Path, Mask: string; var List: TStrings; IncludeSubDir: Boolean = True);

var

SearchRec: TSearchRec;

FindResult: Integer;

begin

List.BeginUpdate;

try

Path:=IncludeTrailingBackSlash(Path);

FindResult:=FindFirst(Path+'*.*', faAnyFile, SearchRec);

try

while FindResult = 0 do with SearchRec do begin

if (Attr and faDirectory<>0) then begin

if IncludeSubDir and (Name<>'..') and (Name<>'.')

then FindFiles(Path+Name, Mask, List, IncludeSubDir);

end

else begin

if MatchesMask(Name, Mask) then List.Add(Path+Name);

end;

FindResult:=FindNext(SearchRec);

end;

finally

FindClose(SearchRec);

end;

finally

List.EndUpdate;

end;

end;

function MyWinExec(FileName : String; Visibility : integer = SW_SHOWDEFAULT) : boolean;

var

zAppName:array[0..512] of char;

StartupInfo:TStartupInfo;

ProcessInfo:TProcessInformation;

begin

StrPCopy(zAppName,FileName);

FillChar(StartupInfo,Sizeof(StartupInfo),#0);

StartupInfo.cb := Sizeof(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow := Visibility;

result := CreateProcess(nil,

zAppName, { указатель командной строки }

nil, { указатель на процесс атрибутов безопасности }

nil, { указатель на поток атрибутов безопасности }

false, { флаг родительского обработчика }

CREATE_NEW_CONSOLE or { флаг создания }

NORMAL_PRIORITY_CLASS,

nil, { указатель на новую среду процесса }

nil, { указатель на имя текущей директории }

StartupInfo, { указатель на STARTUPINFO }

ProcessInfo) { указатель на PROCESS_INF }

end;

procedure TForm1.FormCreate(Sender: TObject);

var i : integer;

procedure CreateColumn(var ListView: TListView);

var

NewColumn : TListColumn;

begin

with ListView 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 := 'Скрытый';

NewColumn := Columns.Add;

NewColumn.Caption := 'Сист.';

Columns[0].Width := 120;

Columns[1].Width := 45;

Columns[2].Width := 80;

Columns[3].Width := 100;

Columns[4].Width := 58;

Columns[5].Width := 40;

end

end;

begin

CreateColumn(ListView1);

CreateColumn(ListView2);

SecondP.road := GetCurrentDir;

SecondP.numSort := 0;

Chesked_1Or2 := Second;

ShowDirectory(SecondP.road,ListView2);

ListView2.Items[0].Selected := true;

FirstP.road := 'C:';

FirstP.numSort := 0;

Chesked_1Or2 := First;

ShowDirectory(FirstP.road,ListView1);

ListView1.Items[0].Selected := true;

for i := 0 to 7 do begin

StatusBar1.Panels.Add;

StatusBar1.Panels[i].Width := form1.Width div 8;

StatusBar1.Panels[i].Bevel := pbRaised;

StatusBar1.Panels[i].Alignment := taCenter;

end;

StatusBar1.Panels.Items[0].Text := 'F1 - Помощь';

StatusBar1.Panels.Items[1].Text := 'F2 - Переимен.';

StatusBar1.Panels.Items[2].Text := 'F3 - Найти файл';

StatusBar1.Panels.Items[3].Text := 'F4 - Редактир.';

StatusBar1.Panels.Items[4].Text := 'F5 - Копировать';

StatusBar1.Panels.Items[5].Text := 'F6 - Переместить';

StatusBar1.Panels.Items[6].Text := 'F7 - Созд. кат.';

StatusBar1.Panels.Items[7].Text := 'F8 - Удалить';

end;

procedure TForm1.AddNewFile(F : TSearchRec; var ListView: TListView);

var i : integer;

ext : string;

begin

if F.Name <> '.' then

with ListView.Items.Add, F do begin

if (Attr and faDirectory) <> 0 then begin

Caption := AnsiUpperCase(Name);

SubItems.Add('');

ImageIndex := 0;

SubItems.Add('Папка')

end

else begin

Name := AnsiLowerCase(Name);

ext := ExtractFileExt(Name);

i := pos(ext,Name);

if i = 0 then Caption := Name

else begin

Caption := copy(Name,1,i-1);

ext := copy(ext,2,length(ext)-1)

end;

SubItems.Add(ext);

if (ext = 'bmp')or(ext = 'jpg')or(ext = 'jpeg')or(ext = 'gif') then ImageIndex := else

if (ext = 'txt')or(ext = 'doc')or(ext = 'log') then ImageIndex := 2

else

if (ext = 'exe')or(ext = 'com')or(ext = 'bat') then ImageIndex := 3

else

if (ext = 'ini')or(ext = 'dll')or(ext = 'sys') then ImageIndex := 4

else ImageIndex := 5;

SubItems.Add(IntToStr(Size))

end;

SubItems.Add(DateTimeToStr(FileDateToDateTime(Time)));

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.ShowDirectory(road : string; var ListView: TListView);

var

F : TSearchRec;

numD,numF,filesize : integer;

begin

ListView.Clear;

numD := 0;

numF := 0;

filesize := 0;

if FindFirst(road+'\*.*', faAnyFile, F) = 0 then begin

repeat

AddNewFile(F,ListView);

if (F.Attr and faDirectory) <> 0 then begin

if (F.Name<>'..')and(F.Name<>'.') then inc(numD)

end

else begin

inc(numF);

inc(filesize,round(F.Size/1000))

end

until FindNext(F) <> 0;

ListView.AlphaSort;

ListView.ItemIndex := 0

end;

FindClose(F);

if Chesked_1Or2 = First then begin

label3.Caption := road;

label5.Caption := 'Папок '+IntToStr(numD)+' В '+IntToStr(numF)+' файлах - '+IntToStr(filesize)+' Kб'

end

else begin

label4.Caption := road;

label6.Caption := 'Папок '+IntToStr(numD)+' В '+IntToStr(numF)+' файлах - '+IntToStr(filesize)+' Kб'

end

end;

procedure TForm1.ListView0Compare(Item1, Item2: TListItem; var Compare: Integer; n : byte);

label repeatCase;

begin

if ((Item1.ImageIndex=Item2.ImageIndex)and(Item1.ImageIndex=0))or

((Item1.ImageIndex<>0)and(Item2.ImageIndex<>0)) then

repeatCase :

case n of

0 : if Item1.Caption = Item2.Caption then begin

n := 1; goto repeatCase

end

else

if Item1.Caption < Item2.Caption then Compare := -1

{Название} else Compare := +1;

1 : if Item1.SubItems[0] = Item2.SubItems[0] then begin

n := 0; goto repeatCase

end

else

if Item1.SubItems[0] < Item2.SubItems[0] then Compare := -1

{Расш.} else Compare := +1;

2 : if Item1.SubItems[1] = Item2.SubItems[1] then begin

n := 0; goto repeatCase

end

else

if Item1.ImageIndex<>0 then begin

if (StrToInt(Item1.SubItems[1]) < StrToInt(Item2.SubItems[1])) then Compare := -1

{Размер, б} else Compare := +1

end;

3 : if Item1.SubItems[2] = Item2.SubItems[2] then begin

n := 0; goto repeatCase

end

else

if DateTimeToFileDate(StrToDateTime(Item1.SubItems[2])) < DateTimeToFileDate(StrToDateTime(Item2.SubItems[2])) then Compare := -1

{Дата создания} else Compare := +1;

4 : if Item1.SubItems[3] = Item2.SubItems[3] then begin

n := 0; goto repeatCase

end

else

if Item1.SubItems[3] < Item2.SubItems[3] then Compare := -1

{Скрытый} else Compare := +1;

5 : if Item1.SubItems[4] = Item2.SubItems[4] then begin

n := 0; goto repeatCase

end

else

if Item1.SubItems[4] < Item2.SubItems[4] then Compare := -1

{Сист.} else Compare := +1;

end{case}

else

if Item1.ImageIndex<Item2.ImageIndex then Compare := -1

else Compare := +1

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if key = 13 then begin

if FileExists(Edit1.Text) then begin

if not MyWinExec(Edit1.Text) then ShowMessage('Ошибка выполнения программы!')

end

else

if DirectoryExists(Edit1.Text) then

if Chesked_1Or2 = First then begin

FirstP.road := Edit1.Text;

ShowDirectory(FirstP.road,ListView1)

end

else begin

SecondP.road := Edit1.Text;

ShowDirectory(SecondP.road,ListView2)

end

else ShowMessage('Файл или папка не найдены!')

end

end;

function CopyDir(from,into : String) : boolean;

var

F : TSearchRec;

begin

into := into+'\'+ExtractFileName(from);

result := ForceDirectories(into); //MkDir

FindFirst(from+'\*.*',faAnyFile,F);

FindNext(F);

while FindNext(F) = 0 do

if (F.Attr and faDirectory)<>0 then CopyDir(from+'\'+F.Name,into)

else copyFileTo(from+'\'+F.Name,into+'\'+F.Name);

FindClose(F)

end;

function RemoveTree(dir : String) : boolean;

var

F : TSearchRec;

begin

FindFirst(dir+'\*.*',faAnyFile,F);

FindNext(F);

while FindNext(F) = 0 do

if (F.Attr and faDirectory)<>0 then RemoveTree(dir+'\'+F.Name)

else DeleteFile(dir+'\'+F.Name);

FindClose(F);

result := RemoveDir(dir)

end;

procedure TForm1.ListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

var

road,filename,road_2 : string;

ListView: TListView;

Item : TListItem;

List: TStrings;

begin

case Key of

192 : if Chesked_1Or2 = First then begin

ListView2.SetFocus;

ListViewClick(ListView2)

end

else begin

ListView1.SetFocus;

ListViewClick(ListView1)

end;

13 : ListViewDblClick(Sender);

112 : ShowMessage('Программy составили студенты МГСУ'+#13#10+

'факультета АиИТ (АСУ):'+#13#10+

' Рашидов Р.'+#13#10+

' Зотов Т.'+#13#10+

' Троицкий А.'); //F1 - Помощь

46,113..119 : begin

if Chesked_1Or2 = First then begin

road := FirstP.road;

ListView := ListView1

end

else begin

road := SecondP.road;

ListView := ListView2

end;

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

case Key of

113 : if Item <> nil then begin //F2 - Переимен.

filename := Item.Caption;

if Item.ImageIndex<>0 then begin

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

if RenameFile(road+'\'+filename,road+'\'+InputBox('Переименовать...','Файл '+filename+' в',filename)) then ShowDirectory(road,ListView)

else ShowMessage('Невозможно переименовать файл')

end

else

if Item.Caption<>'..' then

if RenameFile(road+'\'+filename,road+'\'+InputBox('Переименовать...','Директорию '+filename+' в',filename)) then ShowDirectory(road,ListView)

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

end;

114 : begin

repeat

if not InputQuery('Найти...','Введите имя или маску икомого файла',filename) then exit//F3 - Найти

until InputQuery('Найти.. .','Введите каталог, где будет вестись поиск',road);

Memo1.Show;

Memo1.ShowHint := true;

List := Memo1.Lines;

FindFiles(road, filename, List);

if List.Count > 1 then List.Delete(0);

end;

115 : while Item <> nil do begin//F4 - Редактир.

if Item.ImageIndex<>0 then

if Item.SubItems[0] = '' then

MyWinExec('C:\WINDOWS\NOTEPAD.EXE '+road+'\'+Item.Caption)

else

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

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

end;

116 : if Item <> nil then begin//F5 - Копировать

if Chesked_1Or2 = First then road_2 := SecondP.road

else road_2 := FirstP.road;

if InputQuery('Копировать...','Куда...',road_2) then

repeat

filename := Item.Caption;

if Item.ImageIndex<>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;

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.

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