nyuuzyou/wikis huggingface dataset:
Очистка строки слева и справа от указанного символа

=== Очистка строки слева и справа от указанного символа ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Очистка строки слева и справа от указанного символа
Функция возвращает строку Str, очищенную слева и справа от указанного символа Symbol.
Работает быстрее аналогичной функции UBPFD.TrimEx, так как не использует функцию
поиска Pos, имеет более компактный код.
Зависимости: System, SysUtils
Автор: lipskiy, lipskiy@mail.ru, ICQ:51219290, Санкт-Петербург
Copyright: Собственное написание (lipskiy)
Дата: 2 июня 2002 г.
***************************************************** }
function TrimString(Str: string; Symbol: char): string;
begin
 Result := Str;
 if Str = then
 exit;
 Str := Trim(Str);
 // Удаляем в начале строки
 while (length(Str) > 0) and
 (AnsiUpperCase(Str[1]) = AnsiUpperCase(Symbol)) do
 Delete(Str, 1, 1);
 // Удаляем в конце строки
 while (length(Str) > 0) and
 (AnsiUpperCase(Str[length(Str)]) = AnsiUpperCase(Symbol)) do
 Delete(Str, length(Str), 1);
 Result := Str;
end;
Source: http://delphibase.endimus.com
ID: 00861
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Очистка строки слева и справа от указанных символов
Функция возвращает word, очищеный от начальных и конечных символов, которые
попадают в строку TrimSymbols.
Например, ShowMessage (TrimEx('<MegaTeg>', '<>')), выведет сообщение "MegaTeg"
(без кавычек).
Зависимости: system, sysutils
Автор: VID, vidsnap@mail.ru, ICQ:132234868, Махачкала
Copyright: VID
Дата: 25 апреля 2002 г.
***************************************************** }
function TrimEX(Word, TrimSymbols: string): string;
var
 x, a, b: Integer;
begin
 Result := Word;
 if TrimSymbols = then
 exit;
 Word := Trim(word);
 if length(word) = 0 then
 exit;
 x := 0;
 repeat
 x := x + 1;
 until (pos(ansiuppercase(word[x]), ansiuppercase(TrimSymbols)) = 0)
 or (x = length(word));
 a := x;
 x := length(word) + 1;
 repeat
 x := x - 1;
 until (pos(ansiuppercase(word[x]), ansiuppercase(TrimSymbols)) = 0)
 or (x = 1);
 b := x;
 word := copy(word, a, b - a + 1);
 result := word;
end;
Source: http://delphibase.endimus.com
ID: 00862
Ошибка: lock manager out of room

=== Ошибка: lock manager out of room ===
Go to the interbase/bin directory (Windows) or /usr/interbase (Unix) and locate the configuration file isc_config. By default your configuration file will look like this:
 #V4_LOCK_MEM_SIZE        98304
 #ANY_LOCK_MEM_SIZE       98304
 #V4_LOCK_SEM_COUNT       32
 #ANY_LOCK_SEM_COUNT   32
 #V4_LOCK_SIGNAL         16
 #ANY_LOCK_SIGNAL         16
 #V4_EVENT_MEM_SIZE   32768
 #ANY_EVENT_MEM_SIZE      32768
I increased the V4_LOCK_MEM_SIZE entry from 98304 to 198304 and things were fine then.
!!! Important !!!
By default all lines in the config file are commented out with the leading # sign. Make sure to remove the # sign in any line that you change - the default config file just shows the default parameters.
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02908
Category:Базы данных
Category:Interbase
Ошибка BDE32 2104

=== Ошибка BDE32 2104 ===
Пример, приведенный для функции dbiGetDatabaseDesc в файле BDE32.HLP, неверен. Такой же пример содержится в файле TI3100.ASC. Я пробовал это на 3 разных компьютерах. Я использую среду Delphi. Ошибка, которую я получаю при попытке использования функции, выглядит следующим образом:
EDBEngineError с сообщением 'Возникла ошибка при попытке инициализации Borland Database Engine (ошибка $2104).'
При вызове любой из функций BDE, если вы не пользуетесь компонентами для работы с базами данных, вам необходимо инициализировать BDE вызовом dbiInit(nil).
Source: Взято с http://delphiworld.narod.ru
ID: 02589
Ошибка о файле SAA.AAA

=== Ошибка о файле SAA.AAA ===
The 'SAA.AAA' file is a temporary file used in processing a query.
A failure involving this file generally means that InterBase has run out of disk space processing the query.
(Remember that this will be a temporary file on the server, so the server is out of disk space, not your local machine!)
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
----
Этот файл является временным, и создается когда при выполнении запроса возникает необходимость в сортировке результата. Ошибка может возникать при нехватке дискового пространства на томе, куда указывает TEMP. Для NT при работе IB в режиме сервиса необходимо изменить переменную TEMP для System (см. My Computer/Properties/Environment). Для IB 5.x и 6.0 (в архитектуре SuperServer только!) можно указать диски и размер временных файлов в файле конфигурации IBCONFIG, или в переменной окружения INTERBASE_TMP (см. Operations Guide, стр92). Например:
 TMP_DIRECTORY "c:\" 10000000
 TMP_DIRECTORY "e:\temp\" 100000000
Может быть указано несколько дисков или каталогов, которые будут использоваться последовательно. Размер должен быть указан в байтах. Кавычки для имени диска и каталога обязательны.
Author: Дмитрий Кузьменко (http://www.ibase.ru/)
ID: 02909
Category:Базы данных
Category:Interbase
Ошибка при установке Internal error near IBcheck

=== Ошибка при установке Internal error near IBcheck ===
Эта ошибка вызвана порчей ключа registry инсталлятором Delphi 4. Исправить ее можно, запустив RegEdit и проверив ключ HK_CURRENT_USER/Environment. Значение PATH должно быть строкового типа. Если это не так, то PATH надо поменять (или пересоздать) на строковое значение.
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02921
Category:Базы данных
Category:Interbase
Ошибка совместного доступа к базе данных

=== Ошибка совместного доступа к базе данных ===
Подскажите как на дельфи создаются базы данных с которыми можно работать на нескольких компьютерах одновременно (таблицы Paradox). Как буфиризировать таблицы Paradox? Использую компонент DataBase со стандарным драйвером, указываю сетевой путь к БД, но при обращении сразу нескольких пользователей возникает сообщение что каталог заблокирован другим .NET файлом.
Решение:
 Control Panel -> BDE Administrator -> закладка Configuration -> Drivers -> Native -> Paradox
Сделайте где нибудь в сетке каталог доступный со всех компьютеров, Опция Net Dir должна указывать на всех компьютерах должна указывать на этот каталог - в нём будут хранится файлы которые обеспечивают раздельный доступ.
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02496
Ошибка создания дескриптора курсора

=== Ошибка создания дескриптора курсора ===
Вы должны использовать ExecSql вместо Open. К примеру, если имя вашего запроса UpdateStudent, то при необходимости обновления STUDENT.DB вы должны использовать следующий код:
begin
 UpdateStudent.ExecSql();
end;
Ваш запрос является Passtrough-запросом, который не может возвратить установленный результат, так что это не может быть открыто, а должно быть 'ВЫПОЛНЕНО'.
Source: Взято с http://delphiworld.narod.ru
ID: 02588
Панель с двумя полосами слева, которые можно двигать

=== Панель с двумя полосами слева, которые можно двигать ===
Для создания панелей в двумя полосами слева, которые можно двигать друг относительно друга, используют компонент ControlBar (вкладка Additional), на котором обычно размещают один или несколько ToolBar (вкладка Win32). Чтобы сделать возможным "вытаскивание" панели из ControlBar нужно написать следующий код: 
procedure TForm1.FormCreate(Sender: TObject);
begin
 ToolBar1.DockSite := true;
 ToolBar1.DragKind := dkDock;
 ToolBar1.DragMode := dmAutomatic;
end;
procedure TForm1.ControlBar1DockOver(Sender: TObject;
 Source: TDragDockObject; X, Y: Integer; State: TDragState;
 var Accept: Boolean);
begin
 Accept := (Source.Control is TToolBar);
 if Accept then
 with Source.DockRect do
 begin
 TopLeft := ControlBar1.ClientToScreen(ControlBar1.ClientRect.TopLeft);
 Right := Left + Source.Control.Width;
 Bottom := Top + Source.Control.Height;
 end;
end;
Вы можете убрать метод FormCreate, установив нужные свойства компонента ToolBar1 на стадии разработки при помощи Object Inspector. 
Source: http://delphiworld.narod.ru/
ID: 00948
Панель с изменяющимися размерами

=== Панель с изменяющимися размерами ===
Привожу исходный код для создания панелей с изменяющимися размерами. Выровняйте панель по области клиента свойством alClient, расположите на ней несколько элементов управления и посмотрите как меняются размеры во время изменения размера формы при выполнении программы. Можно расширить код и запретить изменения размеров во время проектирования, но это я оставляю для вас. Данная технология может и не идеальна, поскольку я накропал код за считанные минуты, но для выполнения моих задач этого достаточно.
unit Elastic;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, ExtCtrls;
type
 TElasticPanel = class(TPanel)
 private
 FHorz, FVert: boolean;
 nOldWidth, nOldHeight: integer;
 bResized: boolean;
 protected
 procedure WMSize(var message: TWMSize); message WM_SIZE;
 public
 nCount: integer;
 constructor Create(AOwner: TComponent); override;
 published
 property ElasticHorizontal: boolean read FHorz write FHorz default TRUE;
 property ElasticVertical: boolean read FVert write FVert default TRUE;
 end;
procedure Register;
implementation
constructor TElasticPanel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FHorz := TRUE;
 FVert := TRUE;
 nOldWidth := Width;
 nOldHeight := Height;
 bResized := FALSE;
end;
procedure TElasticPanel.WMSize(var message: TWMSize);
var
 bResize: boolean;
 xRatio: real;
 i: integer;
 ctl: TWinControl;
begin
 Inc(nCount);
 if Align = alNone then
 bResize := TRUE
 else
 bResize := bResized;
 if not (csDesigning in ComponentState) and bResize then
 begin
 if FHorz then
 begin
 xRatio := Width / nOldWidth;
 for i := 0 to ControlCount - 1 do
 begin
 ctl := TWinControl(Controls[i]);
 ctl.Left := Round(ctl.Left * xRatio);
 ctl.Width := Round(ctl.Width * xRatio);
 end;
 end;
 if FVert then
 begin
 xRatio := Height / nOldHeight;
 for i := 0 to ControlCount - 1 do
 begin
 ctl := TWinControl(Controls[i]);
 ctl.Top := Round(ctl.Top * xRatio);
 ctl.Height := Round(ctl.Height * xRatio);
 end;
 end;
 end
 else
 begin
 nOldWidth := Width;
 nOldHeight := Height;
 end;
 bResized := TRUE;
 nOldWidth := Width;
 nOldHeight := Height;
end;
procedure Register;
begin
 RegisterComponents('Additional', [TElasticPanel]);
end;
end.
Source: http://delphiworld.narod.ru/
ID: 00950
Первая буква каждого слова в верхнем регистре

=== Первая буква каждого слова в верхнем регистре ===
Для слов из латинских букв
function LowCase(ch: CHAR): CHAR;
begin
 case ch of
 'A'..'Z': LowCase := Chr(Ord(ch) + 31);
 else
 LowCase := ch;
 end;
end;
function proper(s: string): string;
var
 t: string;
 i: integer;
 newWord: boolean;
begin
 if s = then
 Exit;
 s := LowerCase(s);
 t := UpperCase(s);
 newWord := true;
 for i := 1 to Length(s) do
 begin
 if newWord and (s[i] in ['a'..'z']) then
 begin
 s[i] := t[i];
 newWord := false;
 Continue;
 end;
 if s[i] in ['a'..'z', '] then
 Continue;
 newWord := true;
 end;
 Result := s;
end;
Source: http://delphiworld.narod.ru/
ID: 00848
----
function TfrmLoadProtocolTable.ToMixCase(InString: string): string;
var
 I: Integer;
begin
 Result := LowerCase(InString);
 Result[1] := UpCase(Result[1]);
 for I := 1 to Length(InString) - 1 do
 begin
 if (Result[I] = ' ') or (Result[I] = ') or (Result[I] = '"')
 or (Result[I] = '-') or (Result[I] = '.') or (Result[I] = '(') then
 Result[I + 1] := UpCase(Result[I + 1]);
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 00849
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Установка для каждого слова строки верхнего регистра для
первого символа и нижнего регистра для всех остальных
Пусть S = 'hello WOrLd, how aRe YOU?';
При передаче функции в качестве параметра переменной S,
Result = 'Hello World, How Are You?'
Зависимости: sysutils, system
Автор: VID, vidsnap@mail.ru, ICQ:132234868, Махачкала
Copyright: VID
Дата: 30 апреля 2002 г.
***************************************************** }
function PROPER(S: string): string;
const
 Symbols = ' _;.,1234567890';
var
 X: Integer;
begin
 Result := ;
 if Length(s) = 0 then
 exit;
 S[1] := AnsiUpperCase(s[1])[1];
 for X := 1 to length(s) do
 if POS(S[x], Symbols) <> 0 then
 begin
 if X <> Length(s) then
 S[x + 1] := AnsiUpperCase(s[x + 1])[1];
 end
 else
 S[x + 1] := AnsiLowerCase(S[x + 1])[1];
 Result := S;
end;
Source: http://delphibase.endimus.com
ID: 00907
Перебор вариантов

{ Если Х - количество видов букв, из которых состоит генеримое слово,
 а Y - максимальная длинна слова, то общее количество сгенеренных
 слов равно: Z = Y^1 + Y^2 + ... + Y^X }
var
 Gen_Length: Byte; { максимальная длинна слова для генерации }
 Gen_CharArray: String; { массив символов, из которых будет сгенерированы слова }
 InS: String; { строка, из которой будет создан массив Gen_CharArray }
 I: Byte; { счётчик }
 F: Text; { файл для сохранения сгенерированных слов }
{ рекурсивная процедура генерации слова }
procedure GenNext(Gen_LastCharNo: Byte; Gen_Str: String);
var
 I: Byte; { счётчик }
begin
 { генерируем до тех пор, пока не достигнем последнего символа в массиве генерации }
 for I := 1 to Byte(Gen_CharArray[0]) do
 begin
 { устанавливаем длину строки слова, которое сейчас сгенерируем }
 Byte(Gen_Str[0]) := Gen_LastCharNo;
 { изменяем последний символ генерируемого слова, которое нам передано
 в заголовке процедуры }
 Gen_Str[Gen_LastCharNo] := Gen_CharArray[I];
 { слово сгенерировано, записываем в файл }
 WriteLn(F, Gen_Str);
 { если мы не достигли максимальной длинны слова, вызываем себя рекурсивно,
 указав, что уже следующи символ будет последним и передавая уже
 сгенерированный кусок строки }
 if Gen_Length > Gen_LastCharNo then
 GenNext(Gen_LastCharNo+1, Gen_Str);
 end;
end;
begin
 Gen_CharArray := 'DELPHI';
 { в примере максимальная длинна слова для генерации равна длине массива символов }
 Gen_Length := Byte(Gen_CharArray[0]);
 Assign(F, 'OUTPUT.TXT');
 ReWrite(F);
 { запускаем генерацию
 Gen_LastCharNo - последний символ будет иметь номер 1
 Gen_Str - пока строка пуста }
 GenNext(1, );
 Close(F);
end.
Author: --= Eagle =--
ID: 04182
Category:Алгоритмы
Перебор всех компонентов на форме

=== Перебор всех компонентов на форме ===
Например, надо найти все TCheckBox на форме и установить из все в положение checked:
var i: Integer;
begin
 for i := 0 to ComponentCount - 1 do
 if Components[i] is TCheckBox then
 (Components[i] as TCheckBox).Checked := True;
end;
Author: Vit (Vitaly Nevzorov) (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00353
Перевернуть строку

== Возврат перевернутой строки ==
// Перевернуть строку
function ReverseString(s: string): string;
var
 i: Integer;
begin
 Result := ;
 if Trim(s) <> then
 for i := Length(s) downto 1 do
 Result := Result + s[i];
end;
Author: Автор: ___Nikolay
Source: http://delphiworld.narod.ru/
ID: 04207
----
== Переворот переданной строки ==
procedure ReverseString(var s: string);
var
 i: Integer;
 c: char;
begin
 if s <> then
 for i := 1 to Length(s) div 2 do
 begin
 c := s[i];
 s[i] := s[Length(s) + 1 - i];
 s[Length(s) + 1 - i] := c;
 end;
end;
Author: Автор: Profit Manson 
Source: http://delphiworld.narod.ru/
ID: 04208
----
== Возврат перевернутой строки, оптимизирован ==
function ReverseString(const s: string): string;
var
 i, len: Integer;
begin
 len := Length(s);
 SetLength(Result, len);
 for i := len downto 1 do
 begin
 Result[len - i + 1] := s[i];
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 04209
----
== Возврат перевернутой строки, еще оптимизирован ==
function ReverseString(const Str: string): string;
// by Ido Kanner
var
 ch: Char;
 i, Size: Integer;
begin
 Result := Str;
 Size := Length(Result);
 if (Size >= 2) then // 2 or more chars
 begin
 // For 1 to middle of the string
 for i := 1 to (Size div 2) do
 begin
 // Lets get the charecter of the current place in the string
 ch := Result[i];
 // Place the Current pos of the char
 // with the char of it's mirror place...
 Result[i] := Result[Size - (i - 1)];
 // In the mirror place we will put char of the
 // Original place... And we switched places !!!
 Result[Size - (i - 1)] := ch;
 end
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 04210
----
== Возврат перевернутой строки с использованием PChar ==
function ReverseString(S: string): string;
// by Rudy Velthuis
var
 P, Q: PChar;
 C: Char;
begin
 Result := S;
 if Length(Result) = 0 then Exit;
 P := PChar(Result);
 Q := P + Length(Result) - 1;
 while P < Q do
 begin
 C := P^;
 P^ := Q^;
 Q^ := C;
 Inc(P);
 Dec(Q);
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 04211
----
== Переворот переданной строки с использованием PChar ==
procedure ReverseString(var S: string);
// by Rudy Velthuis
var
 P, Q: PChar;
 C: Char;
begin
 if Length(S) = 0 then Exit;
 P := PChar(S);
 Q := P + Length(S) - 1;
 while P < Q do
 begin
 C := P^;
 P^ := Q^;
 Q^ := C;
 Inc(P);
 Dec(Q);
 end;
end;
Source: http://www.swissdelphicenter.ch
ID: 04212
Category:Алгоритмы
Category:Работа с текстом
Перевести секунды в формат времени

=== Перевести секунды в формат времени ===
const 
 SecPerDay = 86400; 
 SecPerHour = 3600; 
 SecPerMinute = 60; 
function SecondToTime(const Seconds: Cardinal): Double; 
var 
 ms, ss, mm, hh, dd: Cardinal; 
begin 
 dd := Seconds div SecPerDay; 
 hh := (Seconds mod SecPerDay) div SecPerHour; 
 mm := ((Seconds mod SecPerDay) mod SecPerHour) div SecPerMinute; 
 ss := ((Seconds mod SecPerDay) mod SecPerHour) mod SecPerMinute; 
 ms := 0; 
 Result := dd + EncodeTime(hh, mm, ss, ms); 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 label1.Caption := DateTimeToStr(Date + SecondToTime(86543)); 
end; 
Source: http://delphiworld.narod.ru
ID: 00758
Перевод символа в верхний регистр для русского алфавита

=== Перевод символа в верхний регистр для русского алфавита ===
function UpCaseRus(ch: Char): Char;
asm
 CMP AL,'a'
 JB @@exit
 CMP AL,'z'
 JA @@Rus
 SUB AL,'a' - 'A'
 RET
@@Rus:
 CMP AL,'я'
 JA @@Exit
 CMP AL,'а'
 JB @@yo
 SUB AL,'я' - 'Я'
 RET
@@yo:
 CMP AL,'?'
 JNE @@exit
 MOV AL,'?'
@@exit:
end;
Source: http://delphiworld.narod.ru
ID: 00863
Перевод символа в нижний регистр для русского алфавита

=== Перевод символа в нижний регистр для русского алфавита ===
function LoCaseRus( ch : Char ) : Char;
{Перевод символа в нижний регистр для русского алфавита}
asm
 CMP AL,'A'
 JB @@exit
 CMP AL,'Z'
 JA @@Rus
 ADD AL,'a' - 'A'
 RET
@@Rus:
 CMP AL,'Я'
 JA @@Exit
 CMP AL,'А'
 JB @@yo
 ADD AL,'я' - 'Я'
 RET
@@yo:
 CMP AL,'?'
 JNE @@exit
 MOV AL,'?'
@@exit:
end;
Source: http://delphiworld.narod.ru
ID: 00864
Перевод чисел из десятичной, в любую другую систему счисления

{ Функция представляет число Value в Base-ричной системе счисления,
 Base должно находиться в пределах [1..36] и представляется
 10-ю цифрами [0..9] и 26-ю буквами английского алфавита ['A'..'Z'] }
function Dec2X(const Value, Base: Cardinal): string;
 // Функция возвращает символ, соответствующий числу в N-ричной системе
 function GetChar(const N: Cardinal): Char;
 begin
 if N < 10 then // для систем счисления от 1 до 10
 Result := Char(N + Ord('0'))
 else // для систем счисления выше 10, но не больше 36 ([0..9] + ['A'..'Z'])
 Result := Char(N - 10 + Ord('A'));
 end;
var
 V, R: Cardinal;
begin
 Result := ;
 if Base <= 1 then
 begin
 // числа можно и в системе, состоящей из одного символа, представлять ;)
 if Base = 1 then
 begin
 // реализуем это
 SetLength(Result, Value);
 FillChar(Result[1], Value, Ord('0'));
 Exit;
 end
 else
 // а вот других систем счисления быть не может
 raise EConvertError.Create('Основание системы счисления должно быть больше 0');
 end
 else
 // ограничиваем представление систем счисления 10-ю цифрами и 26-ю буквами
 // английского алфавита
 if Base > 10 + (Ord('Z') + 1) - Ord('A') then
 raise EConvertError.Create('Основание системы счисления должно лежать в пределах от 1 до 36');
 // Выполняем преобразование в нужную систему виртуальным делением в столбик
 V := Value;
 repeat
 R := V mod Base;
 V := V div Base;
 Result := GetChar(R) + Result;
 until V < 2; // 2 - минимальная база,
 // то есть в любом случае когда-то "V div Base" будет равно 1
 if V <> 0 then
 Result := IntToStr(V) + Result;
end;
Author: s-mike
ID: 04060
Category:Алгоритмы
Category:Математика
Передача массива записей символов в Memo

=== Передача массива записей символов в Memo ===
Обработка больших строк в 16-битной версии Delphi задача далеко непростая. Особенно когда строки являются частью структуры записи и вы хотите передать их в TMemo. В данном совете показано как создать структуру записи размером 1000 символов, прочесть в нее содержимое Memo и затем записать ее обратно в Memo. Основной метод, который мы здесь используем - метод Memo GetTextBuf. Используемая структура записи представляет собой простую строку и массив из 1000 символов, но структура могла бы быть сложнее.
unit URcrdIO;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, dbtables;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Memo1: TMemo;
 Button2: TButton;
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
type
 TMyRec = record
 MyArray: array[1..1000] of char;
 mystr: string;
 end;
var
 Form1: TForm1;
 MyRec: TMyRec;
 mylist: TStringlist;
 PMyChar: PChar;
 myfile: file;
 mb: TStream;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
 AssignFile(myfile, 'c:\testblob.txt');
 Rewrite(myfile, 1);
 FillChar(MyRec.MyArray, SizeOf(MyRec.MyArray), #0);
 pmychar := @MyRec.MyArray;
 StrPCopy(pmychar, memo1.text);
 BlockWrite(MyFile, MyRec, SizeOf(MyRec));
 CloseFile(MyFile);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 AssignFile(myfile, 'c:\testblob.txt');
 Reset(myfile, 1);
 FillChar(MyRec.MyArray, SizeOf(MyRec.MyArray), #0);
 BlockRead(MyFile, MyRec, SizeOf(MyRec));
 pmychar := @MyRec.MyArray;
 Memo1.SetTextBuf(pmychar);
end;
end.
Source: http://delphiworld.narod.ru
ID: 00784