nyuuzyou/wikis huggingface dataset:
Печать содержимого DBGrid через QuickReport

=== Печать содержимого DBGrid через QuickReport ===
Частенько у пользователя возникает необходимость распечатать отчёт из базы данных. Естественно, что он начинает просить Вас добавить такую возможность в приложение. Как оказалось, при помощи TQuickRep данную задачу можно очень легко решить.
Итак, приступим. Для начала создайте новую форму, назвав её TGridReport, и поместите на неё TQuickRep. Переименуйте QuickRep в GridRep. Затем сделайте следующую процедуру, которая получает в качестве параметра DBGrid:
procedure TGridReport.Preview(Grid: TDBGrid);
var
 i, CurrentLeft, CurrentTop: Integer;
 BMark: TBookmark;
begin
 GridRep.Dataset := Grid.DataSource.DataSet;
 if not GridRep.Bands.HasColumnHeader then
 GridRep.Bands.HasColumnHeader := True;
 if not GridRep.Bands.HasDetail then
 GridRep.Bands.HasDetail := True;
 GridRep.Bands.ColumnHeaderBand.Height := Abs(Grid.TitleFont.Height) + 10;
 GridRep.Bands.DetailBand.Height := Abs(Grid.Font.Height) + 10;
 CurrentLeft := 12;
 CurrentTop := 6;
 { Запись, на которой пользователь останавливается в DBGrid }
 BMark := Grid.DataSource.DataSet.GetBookmark;
 { Запретим мерцание грида в процессе работы отчёта }
 Grid.DataSource.DataSet.DisableControls();
 try
 for i := 0 to Grid.FieldCount - 1 do
 begin
 if (CurrentLeft + Canvas.TextWidth(Grid.Columns[i].Title.Caption)) >
 (GridRep.Bands.ColumnHeaderBand.Width) then
 begin
 CurrentLeft := 12;
 CurrentTop := CurrentTop + Canvas.TextHeight('A') + 6;
 GridRep.Bands.ColumnHeaderBand.Height := GridRep.Bands.ColumnHeaderBand.Height
 + (Canvas.TextHeight('A') + 10);
 GridRep.Bands.DetailBand.Height := GridRep.Bands.DetailBand.Height
 + (Canvas.TextHeight('A') + 10);
 end;
 { Создадим заголовок отчёта при помощи QRLabels }
 with TQRLabel.Create(GridRep.Bands.ColumnHeaderBand) do
 begin
 Parent := GridRep.Bands.ColumnHeaderBand;
 Color := GridRep.Bands.ColumnHeaderBand.Color;
 Left := CurrentLeft;
 Top := CurrentTop;
 Caption:=Grid.Columns[i].Title.Caption;
 end;
 { Создадим тело отчёта при помощи QRDBText }
 with TQRDbText.Create(GridRep.Bands.DetailBand) do
 begin
 Parent := GridRep.Bands.DetailBand;
 Color := GridRep.Bands.DetailBand.Color;
 Left := CurrentLeft;
 Top := CurrentTop;
 Alignment := Grid.Columns[i].Alignment;
 AutoSize := False;
 AutoStretch := True;
 Width := Grid.Columns[i].Width;
 Dataset := GridRep.Dataset;
 DataField := Grid.Fields[i].FieldName;
 CurrentLeft := CurrentLeft + (Grid.Columns[i].Width) + 15;
 end;
 end;
 lblPage.Left := bdTitle.Width - lblPage.Width - 10;
 lblDate.Left := bdTitle.Width - lblDate.Width - 10;
 { Далее вызовем метод предварительного просмотра из QuickRep }
 GridRep.PreviewModal(); { либо, если желаете, то PreviewModal }
 finally
 with Grid.DataSource.DataSet do
 begin
 GotoBookmark(BMark);
 FreeBookmark(BMark);
 EnableControls();
 end;
 end;
end;
Author: Rafael Ribas Aguilу
Source: Взято из http://forum.sources.ru
ID: 03024
Category:Базы данных
Category:DBGrid
Category:QuickReport
Печать содержимого TMemo/TListbox

Как мне вывести на печать все строки компонента TMemo или TListbox?
Нижеприведенная функция в качестве параметра акцептует объект TStrings и распечатывает все строки на принтере, установленном в системе по умолчанию.Поскольку функция использует TStrings, то она может работать с любыми типами компонентов, имеющими свойство типа TStrings, например TDBMemo или TOutline.
uses Printers;
procedure PrintStrings(Strings: TStrings);
var
 Prn: TextFile;
 i: word;
begin
 AssignPrn(Prn);
 try
 Rewrite(Prn);
 try
 for i := 0 to Strings.Count - 1 do
 WriteLn(Prn, Strings.Strings[i]);
 finally
 CloseFile(Prn);
 end;
 except
 on EInOutError do
 MessageDlg('Ошибка печати текста.', mtError, [mbOk], 0);
 end;
end;
ID: 03247
----
Для печати содержимого TMemo или TListbox используйте следующий код:
PrintStrings(Memo1.Lines);
или
PrintStrings(Listbox1.Items);
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03248
Category:Принтер
Category:TMemo
Category:TListBox
Печать содержимого TMemo или TListbox.

=== Печать содержимого TMemo или TListbox. ===
Следующая функция имеет один параметр в виде объекта TStrings и печатает каждую строку на принтер, установленный в системе по умолчанию. Так как эта функция использует TStrings, то она будет работать с различными компонентами, которые содержат свойство типа TStrings, такие как TDBMemo или TOutline:
uses Printers;
procedure PrintStrings(Strings: TStrings);
var
 Prn: TextFile;
 i: word;
begin
 AssignPrn(Prn);
 try
 Rewrite(Prn);
 try
 for i := 0 to Strings.Count - 1 do
 writeln(Prn, Strings.Strings[i]);
 finally
 CloseFile(Prn);
 end;
 except
 on EInOutError do
 MessageDlg('Error Printing text.', mtError, [mbOk], 0);
 end;
end;
Чтобы распечатать содержимое TMemo или TListbox, используйте следующие команды:
 PrintStrings(Memo1.Lines);
или
 
 PrintStrings(Listbox1.Items);
Source: Взято из http://forum.sources.ru
ID: 00644
Печать структуры таблицы Paradox

=== Печать структуры таблицы Paradox ===
procedure TForm1.Button1Click(Sender: TObject);
const
 FieldTypes: array[0..16] of string[10] = ('Unknown', 'String', 'Smallint',
 'Integer', 'Word', 'Boolean', 'Float', 'Currency', 'BCD', 'Date', 'Time',
 'DateTime', 'Bytes', 'VarBytes', 'Blob', 'Memo', 'Graphic');
var
 i, nX, nY, nHeight, nWidth: Integer;
 rtxtMetric: TTextMetric;
 s: array[0..3] of string[10];
begin
 with Table1.FieldDefs, Printer do
 begin
 Update;
 PrinterIndex := -1;
 Title := 'Структура ' + Table1.TableName;
 BeginDoc;
 nX := 0;
 nY := 0;
 WinProcs.GetTextMetrics(Canvas.Handle, rtxtMetric);
 nHeight := rtxtMetric.tmHeight;
 nWidth := rtxtMetric.tmAveCharWidth;
 for i := 0 to Count - 1 do
 begin
 s[0] := IntToStr(Items[i].FieldNo) + #9;
 s[1] := Items[i].Name + #9;
 s[2] := FieldTypes[Ord(Items[i].DataType)] + #9;
 s[3] := IntToStr(Items[i].Size);
 Canvas.TextOut(nX, nY, s[0]);
 Inc(nX, Length(s[0]) * nWidth);
 Canvas.TextOut(nX, nY, s[1]);
 Inc(nX, Length(s[1]) * nWidth);
 Canvas.TextOut(nX, nY, s[2]);
 Inc(nX, Length(s[2]) * nWidth);
 Canvas.TextOut(nX, nY, s[3]);
 nX := 0;
 nY := i * nHeight;
 end;
 EndDoc;
 end;
end;
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02947
Category:Базы данных
Category:Paradox
Печать текста в обход Windows

Откройте файл типа TextFile и пишите в него напрямую:
var
 Lst: TextFile;
begin
 AssignFile(Lst, 'LPT1');
 Rewrite(Lst);
 WriteLn(Lst, 'Здравствуй, мир!');
 Close(Lst);
end.
При этом вы должны помнить, что при данной технологии вы не можете в это же время печатать из другой программы, иначе наступит конец света, а ваша распечатка будет похожа на "запутанный беспорядок".
Если вы планируете посылать на принтер управляющие коды, вызывайте следующую функцию немедленно после перезаписи файла:
procedure SetBinaryMode(var F: Text); assembler;
asm
 mov ax,$4400
 les di,F
 mov bx,word ptr es:[di]
 int $21
 or dl,$20
 xor dh,dh
 mov ax,$4401
 int $21
end;
Author: Steve
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03249
Category:Принтер
Печать ячеек

У кого-нибудь есть пример кода печати в заданной ячейке? Типа PrintAt(row, col, "Text")?
Вот некоторый код, который я нашел после блужданий в группах новостей. Правда сам я его не проверял, но источник утверждает, что он работает. Так что будьте внимательны!
Procedure TForm1.PrintTableClick(Sender: TObject);
var
 xCord: Integer;
 yCord: Integer;
 RecordBuffer: string;
begin
 xCord := 10;
 yCord := 10;
 Table1.First;
 Printer.BeginDoc;
 Printer.Canvas.Font.Name := 'Courier New';
 while not Table1.EOF do
 begin
 RecordBuffer := Concat((Table1.Fields[0].AsString), ' ', (Table1.Fields[1].AsString));
 RecordBuffer := RecordBuffer + Concat(' ', (Table1.Fields[2].AsString);
 { пока все поля не будут в RecordBuffer }
 Printer.Canvas.TextOut(xCord, yCord, RecordBuffer);
 yCord := yCord + 50;
 Table1.Next;
 end;
 Printer.EndDoc;
end;
Буду рад, если помог.
 Lloyd Linklater <Sysop>
 Delphi Technical Support
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03243
Category:Принтер
Category:Базы данных
Пишем программу мониторинга за памятью

=== пишем программу мониторинга за памятью ===
Сегодня мы попытаемся написать программу, которая будет показывать состояние памяти компа. Для начала определим что она будет делать. Ну самое главное что нам нужно, это состояние физической памяти и загруженность ее в %. А дальше, по своему вкусу, добавим еще состояние виртуальной и страничной памяти.
Начнем. Создай новый проект на Делфи (File → New → Application). 
Теперь подумай, как тебе удобней отображать состояние памяти. Для меня лучше в Label, но можно и Edit. Ну это на твое усмотрение. Кидай на форму 7 компонентов Label (в них будет отображаться значение) и еще 7 (это будут пояснения: загруженность, всего физической, использовано физической, всего страничной, использовано страничной, всего виртуальной, использовано виртуальной). Какие не нужны, те отбрось ;).
Теперь кинь таймер (из вкладки System). Это будет наш главный элемент, поэтому поставь интервал по своему усмотрению (у меня он 400). Этот интервал будет отвечать за частоту обновления полей. Ну и для красоты брось ProgressBar (из вкладки Win32). У тебя должно получиться что-то типа этого:
Теперь приступим непосредственно к кодингу. Весь код мы будем писать в процедуру запуска таймера. А вот и код:
procedure TForm1.Timer1Timer(Sender: TObject);
var
 m: TMemoryStatus;
 temp: Integer;
begin
 m.dwLength := SizeOf(m);
 GlobalMemoryStatus(m);
 with m do
 begin 
 Label1.Caption := IntToStr(dwMemoryLoad) + ' %'; // Загруженность памяти
 Label2.Caption := IntToStr(dwTotalPhys) + ' байт'; // Всего физической
 Label3.Caption := IntToStr(dwAvailPhys) + ' байт'; // Свободно физической
 Label4.Caption := IntToStr(dwTotalPageFile) + ' байт'; // Всего страничной
 Label5.Caption := IntToStr(dwAvailPageFile) + ' байт'; // Свободно страничной
 Label6.Caption := IntToStr(dwTotalVirtual) + ' байт'; // Всего виртуальной
 Label7.Caption := IntToStr(dwAvailVirtual) + ' байт'; // Свободно виртуальной
 // Загруженность на ProgressBar1
 ProgressBar1.Max := dwTotalPhys;
 ProgressBar1.Position := dwTotalPhys - dwAvailPhys;
 end;
end;
Вот в принципе и все. Если ты используешь Edit, то вместо LabelX.Caption пиши EditX.Text, где X-номер компонента. И последнее, чтобы ProgressBar выглядела лучше, измени свойство Smooth равным True. Если у тебя возникнут какие-либо вопросы, предложения, пожелания, прошу отправлять их мне по адресу: crazy_script@mail.ru
Source: http://delphi.dax.ru
ID: 02078
Category:Учебники
Пишем свой текст в Меню

=== Пишем свой текст в Меню ===
Когда играешь во встроенную в Windows игру freecell, то справа в меню постоянно пишется сколько осталось карт. Давайте посмотрим, как это делается.
Перво наперво положим компонент главного меню на форму.
Теперь установим свойство OwnerDraw в true. 
Далее создайте, то что Вы хотите вырисовывать в меню и создайте OnDrawItem. 
И добавьте в него следующую строку: 
ACanvas.TextOut(1, ARect.Top+1, 'I am in the MainMenuDrawbar'); 
Не забудьте, если Вы используете изменяющуюся переменную, то измените её в другой функции и всё что надо будет сделать - это вызвать API функцию DrawMenuBar. 
Если Вы используете Delphi 2,3 пользуйтесь сообщениями WM_MESUREITEM и WM_DRAWITEM, чтобы сделать данный эффект. 
Source: Взято из http://forum.sources.ru
ID: 01297
Плавно превратить один рисунок в другой

procedure TForm1.Button1Click(Sender: TObject);
const
 COUNT = 100;
var
 i: Integer;
 x, y: Integer;
 bm, bm1, bm2: TBitMap;
 p1, p2, p: PByteArray;
 c: Integer;
 k: Integer;
begin
 bm := TBitMap.Create;
 bm1 := TBitMap.Create;
 bm2 := TBitMap.Create;
 bm1.LoadFromFile('Bitmap1.bmp');
 bm2.LoadFromFile('Bitmap2.bmp');
 if bm1.Height < bm2.Height then
 begin
 bm.Height := bm1.Height;
 bm2.Height := bm1.Height;
 end
 else
 begin
 bm.Height := bm2.Height;
 bm1.Height := bm2.Height;
 end;
 if bm1.Width < bm2.Width then
 begin
 bm.Width := bm1.Width;
 bm2.Width := bm1.Width;
 end
 else
 begin
 bm.Width := bm2.Width;
 bm1.Width := bm2.Width;
 end;
 bm.PixelFormat := pf24bit;
 bm1.PixelFormat := pf24bit;
 bm2.PixelFormat := pf24bit;
 Form1.Canvas.Draw(0, 0, bm1);
 for i := 1 to count - 1 do
 begin
 for y := 0 to bm.Height - 1 do
 begin
 p := bm.ScanLine[y];
 p1 := bm1.ScanLine[y];
 p2 := bm2.ScanLine[y];
 for x := 0 to bm.Width * 3 - 1 do
 p^[x] := Round((p1^[x] * (COUNT - i) + p2^[x] * i) / COUNT);
 end;
 Form1.Canvas.Draw(0, 0, bm);
 Form1.Caption := IntToStr(Round(i / COUNT * 100)) + '%';
 Application.ProcessMessages;
 if Application.Terminated then
 break;
 end;
 Form1.Canvas.Draw(0, 0, bm2);
 Form1.Caption := 'done';
 bm1.Destroy;
 bm2.Destroy;
 bm.Destroy;
end;
Source: http://delphiworld.narod.ru
ID: 03810
ID: 03896
Category:Графика
Category:Bitmap
Поведение TAB в компоненте RadioGroup

=== Поведение TAB в компоненте RadioGroup ===
При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным? 
Установка свойства RadioGroup'ы TabStop в False должна решить эту проблему - поскольку клавиша Tab будет продолжать работать - перемещаясь сразу на выделенный пункт RadioGroup. 
ID: 01316
Поверка версии Microsoft OLE DB JET 4.X

=== Поверка версии Microsoft OLE DB JET 4.X ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Поверка версии Microsoft OLE DB JET 4.X
Функция определяет, установлен ли набор драйверов
Microsoft OLE DB JET 4.X на компьютере. Пригодится
для тех, кто использует СУБД Accsess. Можно
использовать при инициализации главного DataModule,
формы и т.д.
В принципе, функцию можно использовать для определения
доступности любого поставщика данных : Oracle, MSSQL и т.д.
Функция работает намного быстрее, чем ADODB.GetProviderNames();
Зависимости: ADODB, ActiveX, OleDB
Copyright: Мироводин Дмитрий
Дата: 7 июля 2004 г.
********************************************** }
function CheckMSJetVersion: Integer;
const
 CLSID_JETOLEDB_4_00: TGUID = '{DEE35070-506B-11CF-B1AA-00AA00B8DE95}';
var
 hR: HRESULT;
 OutParam: IUnknown;
begin
 Result := -1;
 hR := CoCreateInstance(
 CLSID_JETOLEDB_4_00,
 Nil,
 CLSCTX_INPROC_SERVER,
 IID_IDBInitialize,
 OutParam);
 if (hR = S_OK) and (OutParam <> nil) then
 begin
 OutParam := nil;
 Result := 1;
 end;
end;
Пример использования:
if (CheckMSJetVersion < 0) then
begin
 ShowMessage('На машине не установлен MS Jet. ');
 Application.Terminate;
end;
Author: Мироводин Дмитрий, support@hcsoft.spb.ru, Санкт - Петербург
ID: 02766
Повтор строки заданное количество раз

=== Повтор строки заданное количество раз ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Повтор строки заданное количество раз
Input - строка для повторения
Rep - количество повторений
Строка на выходе это входная строка повторенная Rep раз.
Зависимости: Стандартные модули
Автор: Ru, DiVo_Ru@rambler.ru, Одесса
Copyright: DiVo 2002 creator Ru (по мотивам функции Str из Word Basic)
Дата: 18 ноября 2002 г.
***************************************************** }
function MulStr(Input: string; Rep: integer): string;
var
 i: integer;
begin
 for i := 0 to Rep - 1 do
 result := result + Input;
end;
// Пример использования: 
s1 := 'Привет';
s := MulStr(s1, 3);
// результат:
s := 'ПриветПриветПривет';
Source: http://delphibase.endimus.com
ID: 00865
Повышение криптоустойчивости шифрования текста любым алгоритмом

{ **** UBPFD *********** by kladovka.net.ru ****
>> Повышение криптоустойчивости шифрования текста любым алгоритмом
Данная функция (AddDisturbToText) представляет собой подготовительную
операцию перед шифрацией текста любым алгоритмом. Функция
добавляет в текст случайное количество непечатных символов,
располагая их хаотически. Таким образом подготовленный текст,
после шифрации одним и тем-же ключом, не зависимо от алгоритма,
каждый раз будет выглядеть по разному и количественно и качественно,
что практически сводит на нет любой статистический анализ. При
расшифровке, непечатные символы элементарно вычищаются функцией
RemoveDisturbFromText.
Зависимости: SysUtils
Автор: Delirium, VideoDVD@hotmail.com, ICQ:118395746
Copyright: Delirium (Master BRAIN) 2004
Дата: 28 февраля 2004 г.
********************************************** }
const
 NPCS:set of char = [ #0..#8, #11, #12, #14..#31, #127];
// Добавление в текст непечатных символов
function AddDisturbToText(Source: string): string;
var
 n, c: Integer;
begin
 Randomize;
 Result := Source;
 n := (Length(Source) * 2) + Random(Length(Source));
 while Length(Result) < n do
 begin
 c := Random(128);
 if Chr(c) in NPCS then
 Insert(Chr(c), Result, Random(Length(Result))+1);
 end;
end;
// Убрать из текста непечатные символы
function RemoveDisturbFromText(Source: string): string;
var
 i: Integer;
begin
 Result := Source;
 i := 1;
 while i < Length(Result) do
 if Result[i] in NPCS then
 Delete(Result, i, 1)
 else
 Inc(i);
end;
Author: Delirium
ID: 04049
Category:Алгоритмы
Category:Шифрование
Category:Безопасность
Поддерживает ли процессор технологию 3DNow

=== Поддерживает ли процессор технологию 3DNow ===
{$ifndef ver80} // так как будем использовать 32-битный регистр
 function 3DNowSupport: Boolean; assembler; 
 asm 
 push ebx 
 mov @Result, True 
 mov eax, $80000000 
 dw $A20F 
 cmp eax, $80000000 
 jbe @NOEXTENDED // 3DNow не поддерживается
 mov eax, $80000001 
 dw $A20F 
 test edx, $80000000 
 jnz @EXIT // 3DNow поддерживается
 @NOEXTENDED: 
 mov @Result, False 
 @EXIT: 
 pop ebx 
 end; 
 {$endif}
ID: 01428
Поддерживает ли система hibernation?

=== Поддерживает ли система hibernation? ===
function HibernateAllowed: Boolean;
type
 TIsPwrHibernateAllowed = function: Boolean;
 stdcall;
var
 hPowrprof: HMODULE;
 IsPwrHibernateAllowed: TIsPwrHibernateAllowed;
begin
 Result := False;
 if IsNT4Or95 then Exit;
 hPowrprof := LoadLibrary('powrprof.dll');
 if hPowrprof <> 0 then
 begin
 try
 @IsPwrHibernateAllowed := GetProcAddress(hPowrprof, 'IsPwrHibernateAllowed');
 if @IsPwrHibernateAllowed <> nil then
 begin
 Result := IsPwrHibernateAllowed;
 end;
 finally
 FreeLibrary(hPowrprof);
 end;
 end;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01702
Поддерживает ли система suspend?

=== Поддерживает ли система suspend? ===
function SuspendAllowed: Boolean;
type
 TIsPwrSuspendAllowed = function: Boolean;
 stdcall;
var
 hPowrprof: HMODULE;
 IsPwrSuspendAllowed: TIsPwrSuspendAllowed;
begin
 Result := False;
 hPowrprof := LoadLibrary('powrprof.dll');
 if hPowrprof <> 0 then
 begin
 try
 @IsPwrSuspendAllowed := GetProcAddress(hPowrprof, 'IsPwrSuspendAllowed');
 if @IsPwrSuspendAllowed <> nil then
 begin
 Result := IsPwrSuspendAllowed;
 end;
 finally
 FreeLibrary(hPowrprof);
 end;
 end;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01705
Поддержка библиотеки сжатия ZLib

В Delphi 7 официально включена поддержка библиотеки сжатия ZLib. Если у вас более старшая версия посмотрите модули ZLib в дистрибутиве среды (они должны быть на диске но подключать придеться самому).
Библиотеки под разные платформы, среды разработок и документация на сайте www.gzip.org/zlib.
Степень сжатия превосходит алгоритм zip. Максимальная степень сжатия по алгоритму ZLib приближается к степени сжатия упаковщиком RAR.
Модули Zlib, ZlibConst.
При использовании необходимо подключить в описании Uses модуль ZLib.
пример использования:
== Компрессия одного потока в другой ==
procedure ComressStream(ASource, ATarget: TStream; compressionRate: TCompressionLevel);
var
 comprStream: TCompressionStream;
begin
 // compression level : (clNone, clFastest, clDefault, clMax)
 comprStream := TCompressionStream.Create(compressionRate, ATarget);
 try
 comprStream.CopyFrom(ASource, ASource.Size);
 comprStream.CompressionRate;
 finally
 comprStream.Free;
 end;
end;
Декомпрессия одного потока в другой:
procedure DecompressStream(ASource, ATarget: TStream);
var
 decompStream: TDecompressionStream;
 nRead: Integer;
 buffer: array[0..1023] of Char;
begin
 decompStream := TDecompressionStream.Create(aSource);
 try
 repeat
 nRead := decompStream.Read(buffer, SizeOf(buffer));
 ATarget.Write(buffer, nRead);
 until nRead = 0;
 finally
 decompStream.Free;
 end;
end;
Author: RoboSol
Source: Взято из http://forum.sources.ru
ID: 03193
Category:Файловая система
Поддержка процедур завершения программы

=== Поддержка процедур завершения программы ===
; procedure AddTerminateProc(TermProc: TTerminateProc);
: Добавляет процедуру в системный список процедур "завершения программы" (termination procedures list), которые вызываются перед окончанием работы приложения. Каждая такая процедура должна возвращать True, когда приложение может быть беспроблемно завершено или False, если приложение не должно быть завершено. Если любая из указанных процедур возвращает False, то выполнение приложения завершено не будет.
; function CallTerminateProcs: Boolean;
: Функция вызывает все подпрограммы, указанные в списке процедур завершения программы (termination procedures list). Если все процедуры и функции списка возвращают True, то CallTerminateProcs возвращает True, в остальных случаях функция возвращает False. Функция CallTerminateProcs вызывается внутренне непосредственно перед завершением выполнения приложения.
Source: Взято с http://atrussk.ru/delphi/
ID: 02069
Подключен ли в своем компе протокол TCP/IP?

Думаю что надёжнее всего "ping 127.0.0.1" потому что другие методы не дадут уверенности что протокол работает нормально.
Почему именно ping 127.0.0.1?
127.0.0.1 - или по другому localhost - это предопределённый протоколом TCP/IP собственный (внутренний) адрес компьютера, так что если TCP/IP установлен и работает, то этот адрес точно есть и должен пинговаться без проблем, кроме того он пингуется без выхода в сеть, и удобен если надо отличить неработоспособность протокола (драйвера) от поломок вне компьютера(хаб, свич, разъёмы, провода, сервера, другие компьютеры).
Author: Vit
Source: http://forum.vingrad.ru
ID: 03342
----
uses Registry;
function TCPIPInstalled: Boolean;
var
 Reg: TRegistry;
 RKeys: TStrings;
begin
 Result := False;
 Reg := TRegistry.Create;
 RKeys := TStringList.Create;
 try
 Reg.RootKey:=HKEY_LOCAL_MACHINE;
 if Reg.OpenKey('\Enum\Network\MSTCP', False) Then
 begin
 reg.GetKeyNames(RKeys);
 Result := (RKeys.Count > 0);
 end;
 finally
 Reg.free;
 RKeys.free;
 end;
end;
Source: http://forum.sources.ru
ID: 03343
Category:Связь