Программа на Delphi
	
	
программы. Program активизирует выполнение процедур и функций в 
используемых ею модулях Unit. 
                           16.1. Структура модуля 
Модуль имеет следующую структуру: 
      Unit ; 
      interface 
      implementation 
      initialization 
      finalization 
      end. 
                           16.2. Раздел Interface 
Раздел Interface модуля Unit предназначен для описания внешних компонент: 
используемых модулей, типов, констант, переменных, заголовков процедур и 
функций. Так, в вышеприведенном примере в разделе Interface содержатся: 
    . в списке Uses – ссылки на модули Windows, Messages, SysUtils, 
      Graphics, Controls, Forms, StdCtrls; 
    . в секции Type – описание типа экранной формы – класс TForm1; 
    . в секции Var – описание переменных Form1, b, i и описание заголов-ка 
      функции OneSymbStr, предназначенной для создания строки повторяю-щихся 
      d раз символов Ch. 
                         16.3. Раздел Implementation 
Раздел Implementation модуля Unit предназначен для описания внутренних, 
т.е. доступных к использованию только внутри данного Unit, компонент: 
типов, констант, переменных, процедур и функций. Так, в вышеприведенном 
примере в разделе Implementation содержится описание процедуры 
TForm1.Button1Click(Sender: TObject) и функции OneSymbStr. 
                   16.4. Инициирование и завершение модуля 
Всякий модуль может содержать блок инициирования и блок завершения. Эти 
блоки располагаются в нижней части модуля, непосредственно примыкая к 
последнему оператору end. Первый блок начинается словом initialization, 
второй – словом finalization. 
Блок инициирования initialization заканчивается последним оператором end 
модуля либо, при наличии блока завершения, продолжается до слова 
finalization. 
Обычно в блоке инициирования располагаются операторы определения начальных 
значений каких-либо переменных, выделения ресурсов памяти, открытия файлов 
и пр., т. е. все то, что необходимо инициализировать в модуле до передачи 
управления в использующие его модули. 
Блок завершения может быть использован только в том случае, если модуль 
имеет блок инициирования. Этот блок, в противоположность блоку 
инициирования, предназначен для размещения операторов завершения, т. е. 
операторов освобождения ресурсов памяти, закрытия ранее открытых в блоке 
инициирования файлов и пр. 
Например, модуль может заканчиваться следующими операторами: 
      … 
      Initialization {инициирование} 
      Ga:= 0; 
      AssignFile(f, 'c:\Projects\BreadPro\First.dat'); 
      Reset(f, SizeOf(Rec1)); 
      New(AppMem); 
      Finalization {завершение} 
      Dispose(AppMem); 
      CloseFile(f); 
      End. {последний оператор модуля} 
Если несколько модулей имеют блоки инициирования, то они выполняются в том 
порядке, в котором имена модулей располагаются в списке Uses головной 
программы. Если несколько модулей содержат блоки завершения, то они 
выполняются в порядке, противоположном порядку перечисления модулей в 
списке uses головной программы. 
                                  17. Файлы 
Файлом называется область данных на внешнем носителе – жестком диске, 
дискете и пр. Всякий файл имеет имя, представляющее собой строку символов. 
Различают обычное имя (или просто имя) и полное имя. Под полным именем 
понимается абсолютный адрес файла, состоящий из пути и имени файла. 
Например, строка 'C:\Program Files\Folder1\Students.dat' является полным 
именем. Оно состоит из пути 'C:\Program Files\Folder1' к файлу и собственно 
имени файла 'Students.dat'. Это означает, что файл 'Students.dat' 
расположен на диске C в папке (директории) Program Files непосредственно в 
подпапке (субдиректории) Folder1. 
Ранее упоминалось, что в языке Object Pascal существует три типа файлов: 
 = TextFile; {текстовые файлы} 
 = File; {файлы без типа} 
 = File of ; {файлы с типом} 
                          17.1. Файловая переменная 
Для того чтобы получить доступ к файлу, его необходимо сначала открыть. 
Открытие файла выполняется посредством связывания файла с особой 
переменной, называемой файловой переменной. Именно файловая переменная и 
характеризует тип файла. Связывание файла с файловой переменной еще не 
означает открытия этого файла. Открытие файла производится специальными 
процедурами, о которых будет упомянуто ниже. 
Связывание файла с файловой переменной производится с помощью стандартной 
процедуры AssignFile, которая имеет заголовок: 
AssignFile(, ); 
Например, фрагмент 
           Var 
           f1: TextFile; 
           FullPath: String[60]; 
           … 
           FullPath:= 'a:\a1.res'; 
           AssignFile(f1, FullPath); 
cодержит объявление файловой переменной f1 текстового типа и строки 
FullPath, которые затем используются в исполнительной части для указания 
полного имени файла и связывания его с файловой переменной f1. 
                            17.2. Текстовые файлы 
Текстовой файл – это последовательность символьных строк перемен-ной длины. 
Всякая строка завершается маркером конца строки, всякий текстовой файл 
завершается маркером конца файла. Такие файлы можно обрабатывать только 
последовательно. Один и тот же текстовой файл не может быть открыт 
одновременно для ввода и вывода. Файловая переменная этого файла имеет тип 
TextFile или просто Text. 
Для текстовых файлов есть две стандартные файловые переменные – Input и 
Output, которые не нужно объявлять отдельно. 
          17.2.1. Процедуры и функции для работы с текстовым файлом 
   1. Procedure AssignFile(f: TextFile; FileName: String); 
      Связывает файловую переменную f с дисковым файлом FileName. 
   2. Procedure Append(f: TextFile); 
      Открывает существующий файл для добавления строк в конец файла. При 
      отсутствии файла возникает ошибка ввода/вывода. 
   3. Procedure Rewrite(f: TextFile); 
      Создает новый файл и открывает его для вывода. Если файл существует, 
      то он уничтожается и создается как новый. Когда новый текстовой файл 
      закрывается, к нему автоматически добавляется маркер конца файла. 
   4. Procedure Reset(f: TextFile); 
      Открывает существующий файл для чтения и устанавливает указатель на 
      первую строку файла. При его отсутствии возникает ошибка ввода/вывода. 
   5. Procedure Read( f: TextFile[; v1, v2, …,vN]); 
      Читает данные из файла и заносит их в переменные v1, v2, …, vN. 
      Переменные могут иметь символьный, строчный или арифметические типы. 
   6. Procedure Readln( f: TextFile[; v1, v2, …,vN]); 
      Читает данные из файла целыми строками и заносит их в переменные v1, 
      v2, …, vN. Если список переменных пуст, то происходит перемещение 
      указателя на следующую строку. 
   7. Procedure Write( f: TextFile[; v1, v2, …,vN]); 
      Записывает данные из переменных v1, v2, …, vN в файл в символьном 
      виде. 
   8. Procedure SetTextBuf ( f: TextFile; Var Buf[; Size: Integer]); 
      Устанавливает буфер чтения текстового файла. Процедура должна быть 
      вызвана после AssignFile, но до первого вызова процедур чтения. Буфер 
      используется для чтения больших фрагментов файла, включая символы 
      конца строк. Если размер буфера не указан, то по умолчанию он 
      принимается равным 128. 
   9. Procedure CloseFile( f: TextFile); 
      Закрывает текстовой файл. 
  10. Procedure Flush( f: TextFile); 
      Выводит содержимое внутреннего буфера в файл. 
  11. Function Eof( f: TextFile): boolean; 
      Возвращает True, если достигнут конец файла. 
  12. Function Eoln( f: TextFile): boolean; 
      Возвращает True, если достигнут конец текущей строки. 
  13. Function SeekEof( f: TextFile): boolean; 
      Возвращает статус конца файла. 
  14. Function SeekEoln( f: TextFile): boolean; 
Возвращает статус конца строки. 
Пример: 
      Var 
      F1, F2: TextFile; 
      Ch: Char; 
      St: String[255]; 
      Buf: array[1..4096] of Char; { текстовой буфер размером 4K} 
      begin 
      AssignFile(F1, 'T1.TXT'); 
      SetTextBuf(F1, Buf); { большой буфер для ускорения чтения} 
      Reset(F1); {F1 открыт для чтения} 
      AssignFile(F2, 'WOOF.DOG'); 
      Rewrite(F2); {F2 создан как новый для вывода } 
      while not Eof(F1) do {пока не достигнут конец файла – выполнять} 
      begin 
      Read(F1, Ch); {читает один символ из файла F1} 
      Write(F2, Ch); {пишет один символ в файл F2} 
      end; 
      CloseFile(F1); {файл F1 закрыт} 
      CloseFile(F2); {файл F2 закрыт} 
      Reset(F1); {F1 снова открыт для чтения} 
      Rewrite(F2); {F2 снова создан для вывода } 
      while not Eof(F1) do {пока не достигнут конец файла – выполнять} 
      begin 
      Readln(F1, St); {читает строку из файла F1} 
      Write(F2, St); {пишет строку в файл F2} 
      end; 
      CloseFile(F1); {файл F1 закрыт} 
      CloseFile(F2); {файл F2 закрыт} 
      end; 
Приведенный фрагмент модуля является демонстрационным и предназначен для 
копирования файла 'T1.TXT' в файл 'WOOF.DOG' . В первом цикле While – do 
копирование ведется посимвольно, во втором цикле – построчно. 
Пример процедуры, записывающей в конец текстового файла строку символов: 
Procedure AddStrToTextFile(nF, St:String); 
Var f: Text; 
Begin 
AssignFile(f, nF); 
If not FileExists(nF) then Rewrite(f) {не существует, создать и открыть} 
Else {иначе} 
Begin 
Reset(f); {существует, открыть } 
While not Eof(f) do Readln(f); {передвинуть указатель в конец файла} 
End; 
Writeln(f, St); {записать строку } 
CloseFile(f); {закрыть файл} 
End; 
К процедуре можно обратиться, например, так: 
Var 
S1: String[58]; 
S2: String[189]; 
… 
AddStrToTextFile('c:\Files\ring.txt', 'Строка символов'); 
AddStrToTextFile('ring.txt', S1); 
AddStrToTextFile('ring.txt', S2); 
                             17.3. Файлы с типом 
Файл состоит из любых однотипных компонент. Доступ к данным осуществляется 
через файловую переменную. В отличие от текстового файла в таком файле 
допустим прямой доступ к любой записи, причем в рамках открытого файла 
допустимо как записывать, так и читать записи. 
Примеры объявления файловой переменной для файлов с типом: 
      Var 
      F1: File of String[45]; 
      F2: File of Real; 
      F3: File of tRecord24; 
После каждого чтения или вывода записи указатель автоматически 
устанавливается на следующую запись. 
       17.3.1. Процедуры и функции для работы с типизированным файлом 
   1. Procedure AssignFile( f: File of Type; FileName: String); 
      Связывает файловую переменную f с дисковым файлом FileName. 
   2. Procedure Rewrite( f: File of Type); 
      Создает новый файл и открывает его. Если файл существует, то он 
      уничтожается и создается как новый. 
   3. Procedure Reset( f: File of Type); 
      Открывает существующий файл и устанавливает указатель на первую 
      запись. При отсутствии файла возникает ошибка ввода/вывода. 
   4. Procedure Read( f: File of Type[; v1, v2, …,vN]); 
      Читает записи из файла и заносит их в переменные v1, v2, …, vN. Чтение 
      начинается с той записи, на которую установлен указатель. Типы файла и 
      переменных должны быть одинаковы. 
   5. Procedure Write( f: File of Type[; v1, v2, …,vN]); 
      Записывает данные из переменных v1, v2, …, vN в файл. Вывод данных 
      начинается с той записи, на которую установлен указатель. Если 
      указатель установлен на существующую запись, то при выводе она будет 
      замещена новой записью. Если одновременно выводится несколько записей, 
      то будет замещено такое же количество существующих записей. Типы файла 
      и переменных должны быть одинаковы. 
   6. Procedure Seek( f: File of Type; N: LongInt); 
      Перемещает указатель на запись с номером N. Первая запись имеет 
      порядковый номер 0. 
   7. Function FilePos( f: File of Type): LongInt; 
      Возвращает номер записи, на которую установлен указатель. 
   8. Procedure CloseFile( f: File of Type); 
      Закрывает файл. 
   9. Function Eof(f: File of Type): boolean; 
      Возвращает True, если достигнут конец файла. 
  10. Function FileSize(f: File of Type): LongInt; 
      Возвращает количество записей в файле. Например, Seek(f, FileSize(f)) 
      установит указатель в конец файла (после последней записи). 
  11. Procedure Truncate(f: File of Type); 
      Уничтожает (отрубает) конец файла начиная с записи, на которую 
      установлен указатель. 
                            17.4. Файлы без типа 
Файл состоит из компонент одинакового размера. Тип данных не имеет 
значения. Доступ к данным осуществляется через файловую переменную. Как и в 
файлах с типом, в таком файле допустим прямой доступ к любой записи, причем 
в рамках открытого файла допустимо как писать, так и читать записи. 
Файловая переменная может быть объявлена так: 
                                  Var F: File; 
После каждого чтения или вывода записи указатель автоматически 
устанавливается на следующую запись. 
Отсутствие типа записи позволяет выполнять обработку файлов различных типов 
с помощью универсальных процедур и функций. 
          17.4.1. Процедуры и функции для работы с файлом без типа 
   1. Procedure AssignFile( f: File; FileName: String); 
      Связывает файловую переменную f с дисковым файлом FileName. 
   2. Procedure Rewrite( f: File); 
      Создает новый файл и открывает его. Если файл существует, то он 
      уничтожается и создается как новый. 
   3. Procedure Reset( f: File[; Size: Word]); 
      Открывает существующий файл и устанавливает указатель на первую 
      запись. При отсутствии файла возникает ошибка ввода/вывода. Параметр 
      Size указывает размер записи открываемого файла. При его отсутствии 
      размер записи по умолчанию равен 1. 
   4. Procedure BlockRead( f: File; Var Buf; Count: Word[; Var Result: 
      Word]); 
      Читает из файла Count записей в переменную Buf. Result – реально 
      прочитанное количество записей. 
   5. Procedure BlockWrite( f: File; Var Buf; Count: Word[; Var Result: 
      Word]); 
      Пишет в файл первых Count записей из переменной Buf. Result – реально 
      записанное количество записей. 
   6. Procedure Seek( f: File; N: LongInt); 
      Перемещает указатель на запись с номером N. Первая запись имеет 
      порядковый номер 0. 
   7. Function FilePos( f: File): LongInt; 
      Возвращает номер записи, на которую установлен указатель. 
   8. Procedure CloseFile( f: File); 
      Закрывает файл. 
   9. Function Eof(f: File): boolean; 
      Возвращает True, если достигнут конец файла. 
  10. Function FileSize(f: File): LongInt; 
      Возвращает количество записей в файле. Например, Seek(f, FileSize(f)) 
      установит указатель в конец файла (после последней записи). 
  11. Procedure Truncate(f: File of Type); 
      Уничтожает (отрубает) конец файла начиная с записи, на которую 
      установлен указатель. 
Язык Object Pascal не накладывает никаких ограничений на длину записи 
(теоретически она может иметь размер до 2 Гб). 
Пример описания и обращения к функции ReadFromFile, читающей из файла nF в 
позиции Pos запись r размером Sz. 
function ReadFromFile(nF: String; Pos: Word; Var r; Sz: Word): boolean; 
Var 
g: File; 
Recs, ReadReal: Integer; 
RecRead: boolean; 
Begin 
Assign(g, nF); 
Recs:= FileSize(g) div Sz; {количество записей в файле} 
RecRead:= (Pos < Recs); {запись с номером Pos есть ?} 
if RecRead then begin {если запись есть} 
Reset(g, Sz); {открыть файл} 
try 
Seek(g, Pos); {установить указатель на запись} 
BlockRead(g, r, 1, ReadReal); {прочитать запись} 
RecRead:= (ReadReal = 1); {прочитано успешно ?} 
finally 
Close(g); {закрыть файл} 
end; 
end; 
Result:= RecRead; 
end {ReadFromFile}; 
… 
Type 
tStud = Record 
Fio: String [60]; 
Curs: byte; 
Stipendiya, Room: boolean; 
End; 
Var Stud: tStud; 
… 
if ReadFromFile('base2.ff1', 12, Stud, SizeOf(Stud)) 
then Writeln('Запись из 12-й позиции прочитана'); 
Приведем еще пример. В директории 'c:\Bases\SdudBase' находится файл 
'AllStuds.bs', в котором хранятся данные о студентах в виде записей типа 
      Type 
      TStud = Record {студент} 
      Fio: String[50]; {'Фамилия Имя Отчество'} 
      Born: byte; {Год рождения, например, 1979} 
      Faculty: String[4]; {Факультет, например, 'МТФ'} 
      Group: String[8]; {Группа, например, 'МТ 17-2'} 
      End; 
Ниже приведена универсальная процедура, которая копирует из этого файла в 
другой файл данные только о тех студентах, которые имеют заданный год 
рождения: 
Procedure StudsCopy(nF1, nF2: ShortString; BornYear: byte; 
Var Count: Word; Var: Ind: ShortInt); 
{nF1 – файл-источник, nF2 – файл-приёмник, 
BornYear – требуемый год рождения, 
Count – скопировано записей, 
Ind – индикатор контроля: 
  0 – нормально, 1 – было неверное чтение, была неверная запись} 
Var 
g: tStud; 
K, Sz, i,j: Word; 
f1, f2: File; 
Begin 
Count:= 0; {инициализация счетчика} 
Ind:=0; {изначально предполагаем нормальный процесс, иначе Ind изменим} 
Sz:= SizeOf(g); {размер одной записи} 
K:= KdnFileSize(nF1, Sz); {количество записей в файле-источнике} 
If (K > 0) then {если в файле-источнике есть записи } 
Begin 
Assign(f1, nF1); {файл-источник связываем переменной f1} 
Reset(f,Sz); {открываем файл-источник с записями размера Sz} 
Assign(f2, nF2); {файл-приёмник связываем переменной f2 } 
Rewrite(f2,Sz); {создаем новый файл-приёмник под записи размера Sz} 
try 
For j:=1 to K do 
Begin 
BlockRead(f1, g, 1, i); {чтение записи} 
Case i of 
1: {запись прочитана} 
if (g.Born = BornYear) then { студент имеет требуемый год рождения} 
begin 
BlockWrite(f2, g, 1, i); {запись в файл-приёмник} 
If (i > 0) then Inc(Count) {если записано правильно} 
else 
begin Ind:= 1; Break; End; {записано неверно, сразу выход из цикла} 
end; {if} 
0: begin Ind:= -1; Break; end; {запись не прочитана, сразу выход из цикла} 
end; {Case} 
end; {цикла For} 
finally 
CloseFile(f1); {закрываем файл-источник} 
CloseFile(f2); {закрываем файл-приёмник} 
end; {блока try – finally – end} 
End {If }; 
End {StudsCopy}; 
Операторы, реализующие копирование требуемых данных в файл '1979.bs': 
StudsCopy ('AllStuds.bs', '1979.bs', 1979, Count1979, Ind1979); 
           Case Ind1979 of 
           -1: Writeln('Зафиксирована ошибка чтения'); 
           1: Writeln('Зафиксирована ошибка записи'); 
           0: Writeln('Процесс прошел нормально'); 
           end; {Case} 
      Writeln('Скопировано записей: ' + IntToStr(Count1979)); 
В этом примере использована внешняя процедура KdnFileSize {количество 
записей в файле }. Приведем ее текст: 
      function KdnFileSize(nF: ShortString, Siz: Word): LongInt; 
      {nF – имя файла, Siz – размер одной записи } 
      Var 
      F: File; 
      L: LongInt; 
      Begin 
      L:=0; 
      If FileExists(nF) then 
      begin 
      Assign(f, nF); 
      Reset(f,1); 
      L:= SizeOf(f); 
      If not (L mod Siz = 0) then Writeln('Файл ' + nF + имеет другой тип'); 
      L:= L div Siz; 
      CloseFile(f); 
      End; 
      Result:= L; 
      End; 
               17.5. Процедуры и функции для работы с файлами 
Эти подпрограммы предназначены для работы с файлами, папками (директориями) 
и дисками. 
   1. Procedure ChDir(Dir: String); 
      Делает папку Dir текущей. Пример: ChDir('c:\'); 
   2. Procedure GetDir(D: Byte; Var Dir: String); 
      Возвращает текущую папку на заданном устройстве. (D= 0 – текущий диск, 
      1 – диск А, 2 – диск B и т.д.). Пример: GetDir(0, s); 
   3. Procedure RmDir(Dir: String); 
      Уничтожает заданную папку. Папка не должна содержать вложенных папок 
      или файлов. Пример: RmDir('Folder66'); 
   4. Procedure Erase(f); 
      Удаляет файл, связанный с файловой переменной f. Файл должен быть 
      закрыт. 
   5. Procedure Rename(f, FileName: String); 
      Переименовывает файл, связанный с файловой переменной f. Файл должен 
      быть закрыт. Пример: Rename(g, 'studs.txt'); 
   6. Function DiskFree(D: byte): LongInt; 
      Возвращает количество свободной памяти в байтах на устройстве D. Код 
      драйвера задается так же, как в процедуре GetDir. Если код указан 
      неверно, то возвращает -1. 
   7. Function DiskSize(D: byte): LongInt; 
      Возвращает количество свободной памяти в байтах на устройстве D. Код 
      драйвера задается так же, как в процедуре GetDir. Если код указан 
      неверно, то возвращает -1. 
   8. Function FindFirst(const Path: string; Attr: Integer; 
      var F: TSearchRec): Integer; 
      Находит имя первого файла с заданными атрибутами Attr в папке Path. 
      Результат поиска выводит в переменную F. Если поиск успешен, то 
      функция вернет 0, иначе вернет код ошибки Widows. К FindFirst можно 
      обращаться не только как к функции, но и как к процедуре. 
      Атрибуты файла приведены в табл. 17. 
                                                                  Таблица 17 
|Атрибут            |Описание файлов           | 
|faReadOnly         |Файлы "Только для чтения" | 
|faHidden           |Скрытые файлы             | 
|faSysFile          |Системные файлы           | 
|faVolumeID         |Файл ID-значений          | 
|faDirectory        |Папки (директории)        | 
|faArchive          |Архивы (файлы)            | 
|faAnyFile          |Все файлы                 | 
      Тип, характеризующий найденный файл, представляет запись вида : 
      type 
      TSearchRec = Record 
      Time: Integer; {время} 
      Size: Integer; {размер файла в байтах} 
      Attr: Integer; {атрибуты файла} 
      Name: TFileName; {DOS-путь файла} 
      ExcludeAttr: Integer; 
      FindHandle: THandle; 
      FindData: TWin32FindData; {дополнительная информация о файле} 
      end; 
      Пример: 
      Var 
      SR: TSearchRec; 
      S: String; 
      … 
      FindFirst('c:\Program Files\delphi4\bin\*.*', faAnyFile, SR); 
      if (SR.Attr = faArchive) then 
      S:= 'Файл ' + SR.Name + ' имеет размер ' + IntToStr(SR.Size) + ' 
      байт'; 
      В данном примере процедура FindFirst ищет первый файл по маске '*.*' 
      (все файлы) в папке 'c:\Program Files\delphi4\bin'. Атрибут faAnyFile 
      означает, что поиск производится по всем видам файлов, под которыми 
      понимаются папки (директории), '.', '..' – ссылки на текущую и 
      родительскую папку, внутренние папки и собственно файлы. Последние в 
      терминологии файловой атрибутики называются архивами. Далее, если 
      найденный файл есть архив, т е. файл в общепринятой терминологии, то в 
      строку S будет помещено сообщение. Например, если найденный файл имеет 
      имя Ig.ttg и его размер равен 15899, то S= 'Файл Ig.ttg имеет размер 
      15889 байтов'. 
   1. Function FindNext(var F: TSearchRec): Integer; 
      Находит следующий файл, атрибуты которого указаны в FindFirst. 
   2. Procedure FindClose(var F: TSearchRec); 
      Закрывает действие FindFirst/FindNext. 
   3. Function DeleteFile(const FileName: string): Boolean; 
      Удаляет файл по имени. Если файл не может быть удален или не 
      существует – возвращает False. 
   4. Function CreateDir(const Dir: string): Boolean; 
      Создает новую папку. 
   5. Function GetCurrentDir: string; 
      Возвращает текущую папку. 
   6. Function GetCurrentDir: string; 
      Возвращает текущую папку. 
   7. Function SetCurrentDir(const Dir: string): Boolean; 
      Установка новой текущей папки. 
   8. Function RemoveDir(const Dir: string): Boolean; 
      Удаление папки. Перед удалением папка должна быть пустой. 
   9. Function ExtractFileDir(const FileName: string): string; 
      Выделяет из полного имени файла FileName папку, в которой содержится 
      это файл. 
  10. Function ExtractFilePath(const FileName: string): string; 
      Выделяет из полного имени файла FileName путь до файла. 
  11. Function ExtractFileExt(const FileName: string): string; 
      Возвращает расширение файла FileName. 
  12. Function ExtractFileName(const FileName: string): string; 
      Возвращает имя файла FileName (без расширения). 
  13. Function DirectoryExists(Dir: string): boolean; 
      Проверяет существование директории. Пример: 
      if DirectoryExists('C:\APPS\SALES\LOCAL') then ; 
  14. Function FileExists(FileName: string): boolean; 
      Проверяет существование файла. Примеры: 
      B:= FileExists('C:\APPS\SALES\LOCAL\Fort.pas'); {полное имя} 
      B:= FileExists('Fort.pas'); {указано усеченное имя файла, проверка его 
      существования только в текущей директории} 
  15. Procedure ForceDirectories(Dir: string); 
      Создает новую директорию. 
  16. Procedure ForceDirectories(C:\APPS\SALES\LOCAL). 
      П р и м е ч а н и е. К моменту обращения к процедуре директории APPS и 
      SALES должны существовать. 
Пример процедуры удаления данных из текущей директории, включая файлы и 
вложенные папки. 
Procedure DelInsideDir(FullDir: tPathStr); 
      Var 
      L: Integer; 
      Sr: TSearchRec; 
      dr, q: tPathStr; 
begin 
      if ExistDir(FullDir) then {такая директория есть} 
      begin 
      GetDir(0,dr); {запомнить текущую директорию} 
      ChDir(FullDir); {текущей становится удаляемая директория} 
      L:=FindFirst(Slash(FullDir)+'*.*',faAnyFile,Sr);{поиск первого файла} 
      try 
      While (L = 0) do begin {пока файлы находятся} 
      Case Sr.Attr of 
      faDirectory:{найденный файл – внутренняя директория} 
      if (Sr.Name<>'.') and (Sr.Name<>'..') then {это не ссылка, директория} 
      begin 
      {удаление внутреннего содержимого директории} 
      DelInsideDir(Slash(FullDir)+Sr.Name); 
      q:= Slash(FullDir)+Sr.Name; 
      ChDir(ExtractFilePath(q)); 
      {удаление самой директории (можно, т. к. она теперь пуста)} 
      if NotEmpStr(ExtractFileName(q)) then RmDir(ExtractFileName(q)); 
      end; 
      faArchive: DeleteFile(Sr.Name); {это файл, удаляется} 
      end; {Конец Case-оператора} 
      L:= FindNext(Sr); {следующий файл директории} 
      end; {цикла While} 
      finally 
      FindClose(Sr); {закрыть поиск файлов} 
      end; {try – finally – end} 
      ChDir(dr); {вернуться в текущую директорию} 
      end; {if} 
end;{процедуры} 
Например, если необходимо стереть данные с дискеты, то это можно сделать с 
помощью оператора: DelInsideDir('A:\'); 
                            18. Классы и объекты 
В Object Pascal классами называются специальные типы, которые содержат 
поля, методы и свойства. Предшественником класса является устаревший ныне 
тип языка Turbo Pascal, называемый объектом. Объект был введен в Turbo 
Pascal до создания Delphi. С появлением Delphi в новой версии языка Object 
Pascal объекты, для совместимости со старым программным продуктом, 
сохранены. Однако ныне использование объектов не актуально. 
Класс представляет собой указатель. Однако в отличие от традиционных 
указателей это указатель особого типа: в нем нельзя использовать символ "^" 
при обращении к классу. 
               18.1. Инкаспуляция, наследование и полиморфизм 
Класс, объединяя в себе поля, методы и свойства в единое целое, является 
законченной структурной единицей, предназначенной для решения отдельной 
задачи. Обычно такой задачей является задача разрешения некоторого круга 
сопутствующих проблем. Так, класс TRichEdit представляет собой мощный 
текстовой редактор rtf-файлов (файлов в формате Rich Text Format), который 
предназначен для организации просмотра и редактирования файла, сохранения и 
изменения размеров и типов шрифтов, поиска строк символов и многого 
другого. Такое объединение полей, методов и свойств в единое целое 
называется инкаспуляцией. 
В языке существует множество классов (около 300), которые созданы 
разработчиками языка Object Pascal – сотрудниками фирмы Inprise 
International – для программистов, использующих среду Delphi. Такие классы 
можно назвать фирменными. 
Программист, составляя программу, всегда создает свои пользовательские 
классы. Эти классы создаются либо неявно, когда программист конструирует 
программу визуальными средствами Delphi, а текст классов при этом 
составляет сама Delphi, либо явно, когда программист пишет код класса 
средствами языка Object Pascal. 
Новый класс строится на основе другого, более простого, класса. Для этого в 
заголовке класса указывается его класс-родитель. Синтаксис заголовка нового 
класса имеет вид 
type className = class (ancestorClass) 
      Здесь className – имя нового класса; ancestorClass – имя класса- 
      родителя. Новый класс автоматически наследует поля, методы и свойства 
      своего родителя и может пополниться своими полями, методами и 
      свойствами. Это свойство классов называется наследованием. Возможность 
      наследования позволяет, следуя методу от простого к сложному, 
      создавать классы какой угодно степени сложности. Простейшим классом 
      является класс TObject, который не содержит полей и свойств, однако 
      имеет некоторое множество методов, обеспечивающих создание, 
      уничтожение и обслуживание этого класса и необходимых для нормального 
      функционирования программы. Именно на основе этого общего для всех 
      классов прародителя строится дерево наследования классов. Например: 
      type TPersistent = class (TObject), 
      type TComponent = class (TPersistent), 
      type TControl = class (TComponent). 
Нередко методы, описанные в классе-родителе, оказываются по каким-либо 
причинам неудовлетворительными для класса-потомка. В этом случае в классе- 
потомке можно создать метод с тем же именем, что и в классе-родителе. При 
этом окажется, что в обоих классах будут действовать разные методы с одним 
и тем же именем. Полиморфизм и есть такое свойство родственных классов, 
которое состоит в допустимости объявления в них одноименных методов. 
                           18.2. Синтаксис класса 
      Синтаксис всякого класса имеет вид 
      type className = class (ancestorClass) 
      memberList 
      end; 
Здесь className – имя класса; class – ключевое слово; ancestorClass – тип 
класса-родителя; memberList – список полей, методов и свойств. Ниже 
приведен текст модуля main, содержащий класс TForm1. 
unit main; 
interface 
uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; 
type 
TForm1 = class(TForm) {объявление класса TForm1} 
Button1: TButton; {поле} 
L1: TLabel; {поле} 
L2: TLabel; {поле} 
Button2: TButton; {поле} 
procedure Button1Click(Sender: TObject); {метод} 
procedure FormActivate(Sender: TObject); {метод} 
end; 
Var i: Integer; 
implementation 
{$R *.DFM} 
procedure TForm1.Button1Click(Sender: TObject); {описание метода} 
begin 
L1.Caption:= DateTimeToStr(Date); 
L2.Caption:= TimeToStr(Time); 
end; 
procedure TForm1.FormActivate(Sender: TObject); {описание метода} 
begin 
i:=125; 
end; 
end. 
                              18.3. Поля класса 
Полем может быть любой инкаспулированный в класс тип или другой класс, 
например: 
                 type 
                 TKdnClass = class(TObject) 
                 i, j: integer; 
                 s: String; 
                 TKdn1: TKdn0; 
                 End; 
Если потомком является TObject, то в заголовке его можно опустить. 
Класс-потомок имеет доступ ко всем полям своих предков, но не может их 
переопределять, т. к. он станет недоступен. Пример: 
type 
TPredok = class {объявление класса-предка} 
Value: Integer; 
end; 
TPotomok = class(TPredok) {объявление класса-потомка} 
Value: string; {перекрытие наследуемого поля} 
end; 
var 
My1: TPredok; {объявление переменной класса} 
My2: TPotomok; {объявление переменной-класса} 
begin 
My1 := TPotomok.Create; {создает класс типа TPredok !} 
My2 := TPotomok.Create; {создает класс типа TPotomok} 
My1.Value := 'Hello!'; {ошибка, не тот тип поля TPredok} 
My2.Value := 'Hello!'; {правильно, работает поле Value: String} 
My2.Value := 8; {ошибка: поле Value: Integer перекрыто} 
end; 
В этом примере описано два класса: TPredok – предок и TPotomok – потомок. 
Каждый из классов содержит одноименные поля Value разных типов. 
Далее в var-секции объявлены две различные переменные My1 и My2 типа class. 
На первый взгляд может показаться, что оператор-конструктор объекта My1:= 
TPotomok.Create создаст объект My1 (выделит под него память) типа TPotomok. 
Однако это не так, поскольку My1 имеет другой тип. По этой причине 
конструктор создаст объект родительского типа, т. е. объект типа TPredok. 
Теперь становится понятен источник ошибок, которые имеют место в нескольких 
операторах приведенного примера. 
                             18.4. Методы класса 
Методом класса является инкаспулированная процедура или функция. Эти 
подрограммы объявляются так же, как обычные подпрограммы. Метод должен быть 
объявлен в описании класса в виде отдельного заголовка, а код метода – 
описан в секции implementation с указанием через символ "." принадлежности 
метода к своему классу, например: 
      type 
      TMyClass = class(TObject){объявление класса} 
      ... 
      procedure DoSomething; {объявление метода DoSomething} 
      ... 
      end; 
Описание для DoSomething должно быть приведено позже в секции 
implementation модуля: 
      procedure TMyClass.DoSomething;{вид заголовка класс.метод} 
      begin 
      ... 
      end; 
При обращении к методу возможно использование составного имени либо 
оператора With, например: 
      Var KdnClass: TKdnClass; 
      … 
      KdnClass.MyProc1; // два примера обращения к методам 
      X:= KdnClass.MyFunc2; // с помощью составных имен 
      … 
      With KdnClass do // те же обращения 
      Begin // с помощью оператора With 
      MyProc1; 
      X:=MyFunc2; 
      End; 
Одноименные методы могут перекрываться в потомках точно так, как это 
показано в примере перекрытия полей. Такое перекрытие называется 
статическим. 
Для расширения возможностей чаще используется динамическое перекрытие. Для 
этого родительский метод должен иметь директиву dinamic (динамический 
метод) или virtual (виртуальный метод), а перекрывающий метод – директиву 
override. Пример: 
      type 
      TFigure = class 
      procedure Draw; virtual; {виртуальный метод} 
      end; 
      TRectangle = class(TFigure) 
      procedure Draw; override; {перекрывающий метод} 
      end; 
      TEllipse = class(TFigure) 
      procedure Draw; override; {перекрывающий метод} 
      end; 
В этом примере объявлен виртуальный метод Draw родительского класса TFigure 
и два одноименных метода в классах-потомках TRectangle и TEllipse. 
Последние объявлены перекрывающими (override). 
Такое объявление позволяет перекрывать методы с целью достижения нужных 
целей: 
      var 
      Figure: TFigure; 
      begin 
      Figure := TRectangle.Create; //создание класса 
      Figure.Draw; // вызов TRectangle.Draw 
      Figure.Destroy; // уничтожение класса 
      Figure := TEllipse.Create; //создание класса 
      Figure.Draw; // вызов TEllipse.Draw 
      Figure.Destroy; // уничтожение класса 
      end; 
Семантически виртуальный и динамический методы работают одинаково. Разница 
состоит в том, что виртуальный метод оптимизирует скорость вычислений, а 
динамический метод оптимизирует размер соответствующего программного кода. 
В классе метод может быть объявлен абстрактным с помощью директивы 
adstract. Такой метод является виртуальным или динамическим, однако, в 
отличие от других методов, может не иметь в секции implementation своего 
кода. Класс, имеющий абстрактные методы, называется абстрактным. Такие 
классы и методы могут ничего не делать, инкаспулируя таким способом доступ 
к методам потомков, например: 
procedure DoSomething; virtual; abstract; 
Обращение к неперекрываемому абстрактному методу вызывает ошибку времени 
выполнения (run time error), например: 
      Type 
      TClass2 = class(TClass0) 
      … 
      procedure Paint; virtual; abstract; 
      end; 
      TClass1 = class(TClass0) 
      … 
      procedure Paint; override; 
      end; 
      var 
      jClass1: TClass1; 
      jClass2: TClass2; 
      begin 
      jClass1.Paint; // правильно 
      jClass2.Paint; // неправильно: обращение к абстрактному методу 
      … 
      end; 
Каждый класс имеет два особых метода – конструктор и деструктор. 
Конструктор предназначен для создания класса, т. е. для выделения под него 
динамической памяти. Деструктор, наоборот, предназначен для уничтожения 
класса, т. е. для освобождения участка памяти, занятого этим классом. В 
классе TObject имеются стандартные методы Create (создать) и Destroy 
(уничтожить). В этом классе объявлен также метод Free, который сначала 
проверяет корректность адреса и только потом вызывает метод Destroy. В этой 
связи предпочтительнее использовать метод Free вместо метода Destroy. 
Всякий класс по умолчанию содержит переменную Self, в которую после 
выделения динамической памяти помещается адрес класса. Прежде чем выполнить 
обращение к методам класса, его нужно создать. Хотя конструктор и 
деструктор являются процедурами, они объявляются специальными словами. 
Конструктор объявляется словом Constructor, деструктор – словом Destructor. 
Часто для обеспечения доступа к полям предка в конструкторе необходимо 
предварительно создать класс-предок. Это можно сделать c помощью слова 
Inherited. 
Пример: 
type 
TShape = class(TGraphicControl) 
Private {внутренние объявления} 
FPen: TPen; 
FBrush: TBrush; 
procedure PenChanged(Sender: TObject); 
procedure BrushChanged(Sender: TObject); 
public {внешние объявления} 
constructor Create(Owner: TComponent); override; 
destructor Destroy; override; 
... 
end; 
constructor TShape.Create(Owner: TComponent); 
begin 
inherited Create(Owner); // создание класса-предка TGraphicControl 
Width := 65; // изменение наследуемых свойств TGraphicControl 
Height := 65; 
FPen := TPen.Create; // создание отдельного поля TPen типа class 
FPen.OnChange := PenChanged; 
FBrush := TBrush.Create; // создание отдельного поля TBrush типа class 
FBrush.OnChange := BrushChanged; 
end; 
Некоторые простые классы могут быть созданы и уничтожены без объявления 
конструкторов и деструкторов. Например, если класс является потомком 
TObject, то в нем явно Constructor и Destructor в некоторых случаях 
объявлять нет нужды: 
      Type TClassy = class; 
      .. 
      var Classy: TClassy; 
      … 
      Classy:= TClassy.Create; {создание класса} 
      … 
      Classy:= TClassy.Free; {уничтожение класса} 
В языке имеется возможность объявлять в пределах одного класса несколько 
методов с одним и тем же именем. При этом всякий такой метод должен быть 
перезагружаемым (директива overload). Компилятор такие методы 
идентифицирует по своим уникальным наборам формальных параметров. Для того 
чтобы отменить реакцию компилятора Delphi на появление метода с тем же 
именем, каждый такой метод нужно пометить директивой reintroduce. Далее в 
секции implementation необходимо привести коды всех таких методов. 
Пример: 
      Type TClassy = class; 
      Procedure HH(i, j: byte; var s: String); reintroduce; overload; 
      Procedure HH(q: String); reintroduce; overload; 
      Procedure HH(a: array oh Integer); reintroduce; overload; 
      … 
      implementation 
      … 
      Procedure TClassy.HH(i, j: byte; var s: String); 
      Begin 
      S:=IntToStr(i + j); 
      End; 
      Procedure TClassy.HH(q: String); 
      Begin 
      L2.Cattion:= q; 
      End; 
      Procedure TClassy.HH(a: array oh Integer); 
      Begin 
      L1.Cattion:= IntToStr(a[6] + a[4]); 
      End; 
      … 
Теперь, после обращения к методу по имени TClassy.HH, программа вызовет 
именно тот метод, формальные параметры которого соответствуют фактическим 
параметрам в обращении. 
                            18.5. Свойства класса 
Свойства, как и поля, являются атрибутами класса. Свойства объявляются с 
помощью слов property, read и write. Слова read и write конкретизируют 
назначение свойства. Синтаксис свойства таков: 
property propertyName[indexes]: type index integerConstant specifiers; 
где propertyName – имя свойства; [indexes] – параметры-имена в форме имя1, 
имя2, ... , имяN: type; index – целая константа; read, write, stored, 
default (или nodefault) и implements – спецификации. Всякое объявление 
свойства должно иметь одну из спецификаций read или write или обе вместе. 
Примеры: 
property Objects[Index: Integer]: TObject read GetObject write SetObject; 
property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel; 
property Values[const Name: string]: string read GetValue write SetValue; 
property ErrorCount: Integer read GetErrorCount; 
property NativeError: Longint read FNativeError; 
Неиндексированные свойства похожи на обычные поля, а индексированные 
свойства напоминают поля-массивы. В программе свойства ведут себя почти так 
же, как обычные поля. Разница в том, что свойство имеет более ответственное 
назначение. Например, оно может активизировать некоторые методы для 
придания объектам требуемого свойства. Так если изменено свойство шрифта 
какого-либо визуального класса, то смена свойства шрифта повлечет за собой 
перерисовку текста и выполнение ряда сопутствующих операций, которые 
обеспечат классу именно такое свойство. 
Каждое свойство может иметь спецификацию read или write или оба вместе в 
форме 
                       read fieldOrMethod 
                       write fieldOrMethod 
где fieldOrMethod – имя поля или метода, объявленного в классе, или 
свойство класса-предка. 
Если fieldOrMethod объявлено в классе, то оно должно быть определено в том 
же классе. Если оно объявлено в классе-предке, то оно должно быть видимо из 
потомка, т. е. не должно быть частным полем или методом класса-предка. Если 
свойство есть поле, то оно должно иметь тип. Если fieldOrMethod есть read- 
спецификация, то оно должно быть функцией без параметров, тип которой 
совпадает с типом свойства. Если fieldOrMethod есть write-спецификация и 
метод, то оно должно быть процедурой, возвращающей простое значение или 
константу того же типа, что тип свойства. Например, если свойство 
объявлено: 
property Color: TColor read GetColor write SetColor; 
тогда метод GetColor должен быть описан как 
function GetColor: TColor; 
и метод SetColor должен быть описан как 
procedure SetColor(Value: TColor); 
или 
procedure SetColor(const Value: TColor); 
Если свойство имеет спецификацию read, то оно имеет атрибут "read only" 
(только для чтения). Если свойство имеет спецификацию write, то оно имеет 
атрибут "write only" (только для чтения). 
                           18.6. Структура класса 
Всякий класс имеет структуру, которая состоит из секций. Каждая секция 
объявляется специальным зарезервированным словом. К их числу относятся: 
published (декларированные), private (частные), protected (защищенные), 
public (доступные), automated (автоматизированные). Внутри каждой секции 
сначала объявляются поля, затем – свойства и методы. 
Пример: 
           type 
           TMyClass = class(TControl) 
           private 
           ... { частные объявления здесь} 
           protected 
           ... { защищенные объявления здесь } 
           public 
           ... { доступные объявления здесь } 
           published 
           ... { декларированные объявления здесь } 
           end; 
Секции определяют области видимости компонент класса: 
    . Private – компоненты класса доступны только внутри этого класса; 
    . Public – компоненты класса доступны в текущем и любом другом модуле, 
      который содержит ссылку в списке uses на модуль, в котором объявлен 
      класс; 
    . Published – то же, что Public, однако в ней должны быть перечислены 
      свойства, которые доступны не только на этапе выполнения программы, но 
      и на этапе ее визуального конструирования средствами Delphi; 
    . Protected – cекция доступна только методам текущего класса и методам 
      классов-предков; 
    . Automated – секция используется для объявления свойств и методов 
      обработки OLE-контейнеров в рамках OLE-технологии. 
Порядок следования секций произволен. Любая из секций может быть как 
пустой, так и объявлена несколько раз в рамках одного класса. 
                         18.7. Операции над классами 
Над классами разрешено выполнять две операции – is и as. 
1. Операция is. Синтаксис выражения, содержащего операцию is, имеет вид 
                       object is class 
Это выражение имеет логический тип (boolean) и возвращает True, если 
переменная object имеет тип class класса, иначе – False. 
Пример: 
                 if ActiveControl is TEdit then 
                 TEdit(ActiveControl).SelectAll; 
В этом примере: если класс ActiveControl имеет тип TEdit, то будет выполнен 
метод TEdit(ActiveControl).SelectAll. 
2. Операция as. Синтаксис выражения, содержащего операцию as: 
                            object as class 
Результатом вычисления этого выражения является ссылка на объект того же 
типа, что и тип класса class. При выполнении программы object может иметь 
тот же тип, или тип класса-потомка, или nil. 
Примеры: 
with Sender as TButton do // если Sender имеет тип TButton 
begin // или тип-потомок от TButton 
Caption := '&Ok'; 
OnClick := OkClick; 
end; 
(Sender as TButton).Caption := '&Ok'; //свойству Caption переменной 
// Sender типа TButton или его потомка присваивается значение '&Ok' 
                                                                  Приложение 
                                  Перечень 
                       отлаженных процедур и функций, 
                             написанных автором 
Ниже использованы глобальные типы и переменные: 
Type 
CompareType = (Less, Equal, Greater); 
           Var 
           Lon, Lon2: LongInt; 
           Serv: String[255]; 
   1. Procedure Delay(MilliSec: LongInt); 
      {задержка времени на MilliSec миллисекунд} 
      Var k: LongInt; 
      begin 
      k:=GetTickCount; {в модуле Windows.pas} 
      While GetTickCount0) then Result:= (Price/Expend-1.0)*100.0 
      else Result:= 1.e5; 
      end; 
   6. Procedure Warn1(S: Variant); 
      {Окно с Variant-значением, например Warn1('Процесс закончен')} 
      begin 
      MessageDlg(S, mtInformation, [mbOk], 0); 
      Screen.ActiveForm.Refresh; 
      End; 
   7. Procedure Warn4(s1,s2,s3,s4: String); 
      {то же , что Warn1, но в 4 строки} 
      var i,j: byte; 
      begin 
      i:=Length(s1); j:=i; 
      i:=Length(s2); 
      if (i>j) then j:=i; 
      i:=Length(s3); 
      if (i>j) then j:=i; 
      i:=Length(s4); 
      if (i>j) then j:=i; 
      Warn1(Center(s1,j)+''#13#10+''+Center(s2,j) 
      +''#13#10''+Center(s3,j)+''#13#10+''+Center(s4,j)); 
      end; 
   8. Function DaNet(S: String): boolean; 
      {Окно. Предназначено для вопроса, на который можно ответить, щелкнув 
      по одной из кнопок "Да" или "Нет"} 
      begin 
      DaNet:=MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0)=mrYes; 
      Screen.ActiveForm.Refresh; 
      end; 
   9. Function DaNet4(s1,s2,s3,s4: String): boolean; 
      {Окно. То же, что DaNet, только в 4 строки} 
      begin 
      DaNet4:=MessageDlg(Trim(s1)+''#13#10+''+Trim(s2)+''#13#10''+Trim(s3) 
      +''#13#10+''+Trim(s4),mtConfirmation,[mbYes, mbNo], 0)=mrYes; 
      Screen.ActiveForm.Refresh; 
      end; 
  10. Function InOtrReal(i,a,b: real): boolean; 
      {Если i в орезке [a, b], то возвращает True} 
      begin 
      Result:=(i>=a) and (i 0) and (StartPos = Lon); 
      end; 
  13. Function ChStr(Ch: Char; d: Word): String; 
      {создает строку из символа Ch, повторенного d раз} 
      begin 
      if d>0 then 
      begin 
      SetLength(Result,d); 
      FillChar(Result[1],d,Ch); 
      end; 
      end; 
  14. Function Prop(d: Word): String; 
      {создает строку из d пробелов} 
      begin 
      Result:=ChStr(' ',d); 
      end; 
  15. Function Pad(s: String; d: Word): String; 
      {вставляет справа от строки пробелы, добирая ее до длины d} 
      begin 
      Serv:=s; 
      Lon:=Length(s); 
      If (d>Lon) then Serv:=s+Prop(d-Lon); 
      Result:=Serv; 
      end; 
  16. Function PadCopy(s: String; n,d: Word): String; 
      {копирует из s начиная с позиции n строку длины d. В случае меньшей 
      строки добирает ее до длины d} 
      begin 
      Serv:=Copy(s,n,d); 
      if Length(Serv) < d then Serv:=Pad(Serv,d); 
      Result:=Serv; 
      end; 
  17. Function LeftPad(s: String; d: Word): String; 
      {вставляет слева от строки пробелы, добирая ее до длины d} 
      begin 
      Serv:=s; 
      Lon:=Length(s); 
      if (d>Lon) then Serv:=Prop(d-Lon)+s; 
      Result:=Serv; 
      end; 
  18. Function Center(s: String; d: Word): String; 
      {вставляет слева и справа от строки поровну пробелы, добирая ее до 
      длины d} 
      begin 
      Serv:=s; 
      Lon:=Length(s); 
      Lon2:=Round(0.5*(d-Lon)); 
      if (d>Lon) then Serv:=Prop(Lon2)+s+Prop(d-Lon2); 
      Result:=Serv; 
      end; 
  19. Function CompStrings(s1,s2: String): CompareType; 
      {сравнение строк: s1s2 - Greater} 
      begin 
      if (s1s2) then CompStrings:=Greater 
      else 
      CompStrings:=Equal; 
      end; 
  20. Function CompReal(r1,r2: Real): CompareType; 
      {сравнение вещественных чисел} 
      begin 
      if (r1r2) then Result:=Greater 
      else 
      Result:=Equal; 
      end; 
  21. Procedure IncRe(Var r: Real; h: real); 
      begin 
      r:=r+h; 
      end; 
  22. Function LongToStr(L: LongInt; d: byte): String; 
      {конвертирует целое в строку длины d} 
      begin 
      Str(L,Serv); 
      Result:=LPad(Serv,d); 
      end; 
  23. Function Long2Str(L: LongInt): String; 
      {конвертирует целое в строку} 
      begin 
      Str(L,Serv); 
      Result:=Serv; 
      end; 
  24. Function StrLong(st: String): LongInt; 
      {конвертирует строку в целое } 
      begin 
      Val(Trim(st),Lon,Code); 
      Result:=Lon; end; 
  25. Function Str2Long(st: String; Var L: LongInt): boolean; 
      {конвертирует строку в целое. Возвращает True в случае успеха} 
      begin 
      Val(Trim(st),L,Code); 
      Result:=(Code=0); 
      end; 
  26. Function RealToStr(R: Real; Posle: byte): String; 
      {Конвертирует Real в строку, Posle – количество символов в дробной 
      части R} 
      begin 
      Str(R:20:Posle,Serv); 
      RealToStr:=Trim(Serv); 
      end; 
  27. Function Slash(Dir: String): String; 
      {ставит в конец пути символ '\'} 
      begin 
      Serv:=Trim(Dir); 
      if (Serv[Length(Serv)]<>'\') then Result:=Serv+'\' 
      else Result:=Serv; 
      end; 
  28. Function ChWinDos(Ch: Char): Char; 
      {преобразует русский Windows-символ в русский DOS-символ} 
      Var i,j: byte; 
      begin 
      i:=Ord(Ch); 
      Case i of 
      168: {Ё} j:=240; 
      184: {ё} j:=241; 
      192..255: if (i>239) then j:=i-16 else j:=i-64 
      else j:=i; 
      end; 
      Result:=Char(j); 
      end; 
  29. Function ChDosWin(Ch: Char): Char; 
      {преобразует русский DOS-символ в русский Windows-символ} 
      Var i,j: byte; 
      begin 
      i:=Ord(Ch); 
      Case i of 
      240: {Ё} j:=168; 
      241: {ё} j:=184; 
      128..175: j:=i+64; 
      224..239: j:=i+16 
      else j:=i; 
      end; 
      Result:=Char(j); 
      end; 
  30. Function StrWinDos(st: String): String; 
      {преобразует русскую Windows-строку в русскую DOS-строку} 
      Var 
      n, i: byte; 
      s: ^String; 
      begin 
      New(s); 
      n:=Length(st); 
      s^:= ''; 
      if (n>0) then 
      for i:=1 to n do 
      s^:= s^+ChWinDos(st[i]); 
      Result:=s^; 
      Dispose(s); 
      end; 
  31. Function StrDosWin(s: String): String; 
      {преобразует русскую DOS-строку в русскую Windows-строку} 
      Var 
      n,i: byte; 
      s: ^String; 
      begin 
      New(s); 
      n:=Length(st); 
      s^:= ''; 
      if (n>0) then 
      for i:=1 to n do 
      s^:= s^+ChDosWin(st[i]); 
      Result:=s^; 
      end; 
  32. Function InputStr(const Prompt: String; Var s: String; IsParol: byte): 
      boolean; 
      {ввод строки. Prompt – пояснение, s – вводимая строка, 
      isParol=1, если засекреченный ввод, иначе видимый} 
      begin 
      Result:= 
      KdnInputQuery('Ввод строки', Prompt, s, clBlack, (IsParol=1)); 
      end; 
  33. Function ParolControl(RealParol: String): boolean; 
      {возвращает True, если введенная строка совпадает с RealParol} 
      var 
      b,h: boolean; 
      i: byte; 
      begin 
      St:=''; 
      i:=0; 
      b:=false; 
      Repeat 
      Inc(i); 
      h:=InputStr('Введите пароль ...',St,1); 
      if h then b:= (St=RealParol); 
      if not b and h then Warn1('Ошибка'); 
      Until b or (i=3) or (not h); 
      Result:=b; 
      end; 
  34. Function ExistSubDir(SubDir:String; Dir: tPathStr):boolean; 
      {устанавливает наличие субдиректории SubDir внутри директории Dir. 
      Например, в D:\DIR0001 субдиректории BAR } 
      begin 
      Result:=DirectoryExists(Slash(SubDir)+Dir); 
      end; 
  35. Function GetFileSize(const FileName: string): LongInt; 
      {размер файла} 
      var Sr: TSearchRec; 
      begin 
      if FindFirst(ExpandFileName(FileName), faAnyFile, Sr) = 0 then 
      Result := Sr.Size 
      else Result := -1; 
      end; 
  36. Function FileDateTime(const FileName: string): System.TDateTime; 
      {время создания файла FileName, например: 
      s:= DateTimeToStr(FileDateTime('c:\KdnBread\Bread.exe'))} 
      begin 
      Result := FileDateToDateTime(FileAge(FileName)); 
      end; 
  37. Function HasAttr(const FileName: string; Attr: Word): Boolean; 
      {имеет ли файл FileName атрибут Attr} 
      begin 
      Result := (FileGetAttr(FileName) and Attr) = Attr; 
      end; 
  38. Procedure AppendText(Var f: Text; nF: String); 
      {открывает текстовой файл для добавления строк} 
      begin 
      Assign(f,nF); 
      if KdnFS(nF,1)>0 then Append(f) else Rewrite(f); 
      end; 
  39. Procedure AppendToText(nF,s: String); 
      {добавляет строку в конец текстового файла} 
      Var f: TextFile; 
      begin 
      AppendText(f, nF); 
      Writeln(f,s); 
      CloseFile(f); 
      end; 
  40. Procedure KdnExec(Command: String); 
      {запуск другого приложения, например 'c:\KdnBreadDir\KdnBread.exe'} 
      begin 
      Serv:=Command+#0; 
      If WinExec(@Serv[1], SW_SHOWNORMAL)<32 
      then Warn2('Ошибочное завершение WinExec'); 
      end; 
                                 ЛИТЕРАТУРА 
   1. Зуев В. А.. Turbo Pascal 6.0, 7.0. М.: Веста; Радио и связь, 1993. 384 
      с. 
   2. Епанишников А. М., Епанишников В. А. Программирование в среде Turbo 
      Pascal 7.0. М.: Диалог МИФИ, 1993. 288 с. 
   3. Сван Т. Основы программирования в среде для Windows 95. Пер. с англ., 
      Киев: Диалектика, 1996. 480 с. 
   4. Фаронов В. В. Delphi 4. Учебный курс. М.: Нолидж, 1999. 464 с. 
   5. Федоров А. Г. Создание Windows-приложений в среде Delphi. М.: ТОО 
      "Компьютер Пресс", 1995. 287 с. 
   6. Хендерсон К. Руководство разработчика баз данных в Delphi 2. Киев: 
      Диалектика, 1996. 544 с. 
   7. Шумаков П. В. Delphi 3 и разработка приложений баз данных. М.: Нолидж, 
      1998. 704 с 
   8. Справочная система Delphi 5.0 Help. 
Страницы: 1, 2, 3, 4, 5 
	
	
					
							 |