Я хотел бы создать конструктор 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 и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.