Я хотел бы создать конструктор Load, загружающий список из потока...
Новые потоки в Delphi более разносторонние, чем в BP7. Поскольку вы знаете как пользоваться потоками в BP7, а размер статьи ограничен, то я думаю, что для начала вам необходимо попробовать в действии описанный ниже модуль, инкапсулирующий класс для работы с потоками в стиле BP7. Класс является наследником TComponent, но в нашем случае не было бы никакой разницы, если бы он был наследником TObject. К примеру, вы могли бы адаптировать данный код к своему наследнику TList.
Более важен тот факт, что вы можете использовать поток так, как вам это необходимо, исходя из вашей задачи и специфики. Я сделал работу потока похожую по стилю на BP7, где вначале идет ID класса. В каком-нибудь месте вам необходимо вызвать RegisterType( TYourClass, UniqueIDLikeBP7 ), после чего TYourClass готов к работе с потоками.
Вы наверняка обратили внимание, что я реализовал список зарегистрированных классов (регистратор), где с помощью ID легко можно найти классы, читающие и пишущие в поток в момент вызова конструктора Load соответствующего класса. Код простой и не требующий пояснений. Имейте в виду, что данный код можно использовать для организации передачи данных между существующим файловым потоком BP7 в объекты Delphi - я создал это для осуществления миграции с текущего приложения BP7 в Delphi и осуществления совместимости.
Если вам необходима более подробная информацио о работе потоков в Delphi, обратитесь к соответствующему разделу электронной справки Delphi.
unit CompStrm;
interfaceuses Classes;
type
TCompatibleStream = class;
{ TStreamObject }
TStreamObject = class(TComponent)
constructor Load(S: TCompatibleStream); virtual; abstract;
procedure Store(S: TCompatibleStream); virtual; abstract;
function GetObjectType: word; virtual; abstract;
end;
TStreamObjectClass = classof TStreamObject;
{ TCompatibleStream }
TCompatibleStream = class(TFileStream)
function ReadString: string;
procedure WriteString(var S: string);
function StrRead: PChar;
procedure StrWrite(P: PChar);
function Get: TStreamObject; virtual;
procedure Put(AnObject: TStreamObject); virtual;
end;
{ Register Type : используйте это для регистрации ваших объектов для
работы с потоками с тем же ID, который они имели в OWL }procedure RegisterType(AClass: TStreamObjectClass;
AnID: word);
implementationuses SysUtils, Controls;
var
Registry: TList; { хранение ID объекта и информации о классе }{ TClassInfo }type
TClassInfo = class(TObject)
ClassType: TStreamObjectClass;
ClassID: word;
constructor Create(AClassType: TStreamObjectClass;
AClassID: word); virtual;
end;
constructor TClassInfo.Create(AClassType: TStreamObjectClass;
AClassID: word);
var
AnObject: TStreamObject;
beginifnot Assigned(AClassType) thenraise EInvalidOperation.Create('Класс не инициализирован'
);
ifnot AClassType.InheritsFrom(TStreamObject) thenraise EInvalidOperation.Create('Класс ' + AClassType.ClassName +
' не является потомком TStreamObject'
);
ClassType := AClassType;
ClassID := AClassID;
end;
{ функции поиска информации о классе }function FindClassInfo(AClass: TClass): TClassInfo;
var
i: integer;
beginfor i := Registry.Count - 1 downto 0 dobegin
Result := TClassInfo(Registry.Items[i]);
if Result.ClassType = AClass then
exit;
end;
raise EInvalidOperation.Create('Класс ' + AClass.ClassName +
' не зарегистрирован для работы с потоком');
end;
function FindClassInfoByID(AClassID: word): TClassInfo;
var
i: integer;
AName: string[31];
beginfor i := Registry.Count - 1 downto 0 dobegin
Result := TClassInfo(Registry.Items[i]);
AName := TClassInfo(Registry.Items[i]).ClassType.ClassName;
if Result.ClassID = AClassID then
exit;
end;
raise EInvalidOperation.Create('ID класса ' + IntToStr(AClassID) +
' отсутствует в регистраторе
классов' ) ;
end;
procedure RegisterType(AClass: TStreamObjectClass;
AnID: word);
var
i: integer;
begin{ смотрим, был ли класс уже зарегистрирован }for i := Registry.Count - 1 downto 0 dowith TClassInfo(Registry[i]) doif ClassType = AClass thenbeginif ClassID <> AnID thenraise EInvalidOperation.Create('Класс ' + AClass.ClassName +
' уже зарегистрирован с ID ' +
IntToStr(ClassID));
exit;
end;
Registry.Add(TClassInfo.Create(AClass, AnID));
end;
{ TCompatibleStream }function TCompatibleStream.ReadString: string;
begin
ReadBuffer(Result[0], 1);
if byte(Result[0]) > 0 then
ReadBuffer(Result[1], byte(Result[0
]));
end;
procedure TCompatibleStream.WriteString(var S: string);
begin
WriteBuffer(S[0], 1);
if Length(S) > 0 then
WriteBuffer(S[1], Length(S));
end;
function TCompatibleStream.StrRead: PChar;
var
L: Word;
P: PChar;
begin
ReadBuffer(L, SizeOf(Word));
if L = 0 then
StrRead := nilelsebegin
P := StrAlloc(L + 1);
ReadBuffer(P[0], L);
P[L] := #0;
StrRead := P;
end;
end;
procedure TCompatibleStream.StrWrite(P: PChar);
var
L: Word;
beginif P = nilthen
L := 0
else
L := StrLen(P);
WriteBuffer(L, SizeOf(Word));
if L > 0 then
WriteBuffer(P[0], L);
end;
function TCompatibleStream.Get: TStreamObject;
var
AClassID: word;
begin{ читаем ID объекта, находим это в регистраторе и загружаем объект }
ReadBuffer(AClassID, sizeof(AClassID));
Result := FindClassInfoByID(AClassID).ClassType.Load(Self);
end;
procedure TCompatibleStream.Put(AnObject: TStreamObject);
var
AClassInfo: TClassInfo;
ANotedPosition: longint;
DoTruncate: boolean;
begin{ получает объект из регистратора }
AClassInfo := FindClassInfo(AnObject.ClassType);
{ запоминаем позицию в случае проблемы }
ANotedPosition := Position;
try{ пишем id класса и вызываем метод store }
WriteBuffer(AClassInfo.ClassID, sizeof(AClassInfo.ClassID));
AnObject.Store(Self);
except{ откатываемся в предыдущую позицию и, если EOF, тогда truncate }
DoTruncate := Position = Size;
Position := ANotedPosition;
if DoTruncate then
Write(ANotedPosition, 0);
raise;
end;
end;
{ выход из обработки, очистка регистратора }procedure DoneCompStrm; far;
var
i: integer;
begin{ освобождаем регистратор }for i := Registry.Count - 1 downto 0 do
TObject(Registry.Items[i]
).Free;
Registry.Free;
end;
begin
Registry := TList.Create;
AddExitProc(DoneCompStrm);
end.
Пример программирования на языке Delphi, демонстрирующий создание и использование пользовательских потоков (streams). Код предоставляет реализацию объекта stream, который может быть использован для загрузки и хранения данных.
Вот разбивка кода:
TStreamObject
Это абстрактная базовая класс, представляющая собой объект stream.
Он имеет два виртуальных метода: Load и Store, которые предназначены для переопределения в производных классах для реализации загрузки и хранения данных.
Метод GetObjectType возвращает тип объекта stream.
TStreamObjectClass
Это класс, представляющий собой класс объектов stream.
Он используется как ссылка для регистрации различных типов объектов stream.
TCompatibleStream
Это класс, наследуемый от TFileStream.
Он предоставляет методы для чтения и записи строк, а также реализует методы Get и Put.
Метод Get читает ID объекта из потока и использует его для загрузки соответствующего объекта stream из регистрации.
Метод Put записывает ID объекта в поток и затем вызывает его метод Store.
Registry
Это список зарегистрированных классов, где каждый класс представлен объектом TClassInfo.
Методы FindClassInfo используются для поиска класса в регистрации на основе его типа или ID.
Процедура RegisterType регистрирует новый класс в регистрации.
DoneCompStrm
Это процедура выхода, которая освобождает регистрацию при завершении программы.
Код содержит много комментариев и объяснений, что делает его более понятным. Однако некоторые части могут быть неясными без дополнительного контекста или знаний о программировании на языке Delphi.
Вот несколько предложений:
Код использует TList для хранения зарегистрированных классов, но не ясно почему именно этот тип был выбран.
Процедура RegisterType не проверяет, является ли класс уже зарегистрированным перед добавлением его в регистрацию. Это может привести к дубликатам регистрации.
Процедура DoneCompStrm освобождает регистрацию, но не ясно, что происходит с любыми объектами, загруженными из потока.
В целом, этот код предоставляет хороший старт для создания пользовательских потоков в Delphi и хорошо документирован комментариями и объяснениями. Однако некоторые части могут требовать дополнительной пояснительной информации или модификации для соответствия конкретным использованием.
Реализация собственного потока для обеспечения совместимости при переходе из программы BP7 в Delphi.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.