Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Содержание сайт... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Создание отчето... 65458
Модуль Forms 65218
Пример работы с... 64715
ТЕХНОЛОГИИ ДОСТ... 61911
Имитационное мо... 57791
Реклама
Сейчас на сайте
Гостей: 8
На сайте нет зарегистрированных пользователей

Пользователей: 13,085
новичок: nikita222dolban
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Программа тестирования и обучающая программа по математике на Turbo Pasc...
Диплом - база данных поставщиков на Delphi (MS Sql Server)+ Пояснительна...
Двунаправленный динамический список на Delphi + Блок схемы

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
Реализация собственного потока
Я хотел бы создать конструктор Load, загружающий список из потока...

Новые потоки в Delphi более разносторонние, чем в BP7. Поскольку вы знаете как пользоваться потоками в BP7, а размер статьи ограничен, то я думаю, что для начала вам необходимо попробовать в действии описанный ниже модуль, инкапсулирующий класс для работы с потоками в стиле BP7. Класс является наследником TComponent, но в нашем случае не было бы никакой разницы, если бы он был наследником TObject. К примеру, вы могли бы адаптировать данный код к своему наследнику TList.

Более важен тот факт, что вы можете использовать поток так, как вам это необходимо, исходя из вашей задачи и специфики. Я сделал работу потока похожую по стилю на BP7, где вначале идет ID класса. В каком-нибудь месте вам необходимо вызвать RegisterType( TYourClass, UniqueIDLikeBP7 ), после чего TYourClass готов к работе с потоками.

Вы наверняка обратили внимание, что я реализовал список зарегистрированных классов (регистратор), где с помощью ID легко можно найти классы, читающие и пишущие в поток в момент вызова конструктора Load соответствующего класса. Код простой и не требующий пояснений. Имейте в виду, что данный код можно использовать для организации передачи данных между существующим файловым потоком BP7 в объекты Delphi - я создал это для осуществления миграции с текущего приложения BP7 в Delphi и осуществления совместимости.

Если вам необходима более подробная информацио о работе потоков в Delphi, обратитесь к соответствующему разделу электронной справки Delphi.



unit CompStrm;

interface

uses 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 = class of 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);

implementation

uses 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;

begin
if not Assigned(AClassType) then
raise EInvalidOperation.Create('Класс не инициализирован'
);

if not AClassType.InheritsFrom(TStreamObject) then
raise EInvalidOperation.Create('Класс ' + AClassType.ClassName +
' не является потомком TStreamObject'
);

ClassType := AClassType;
ClassID := AClassID;
end;

{ функции поиска информации о классе }

function FindClassInfo(AClass: TClass): TClassInfo;

var
i: integer;

begin
for i := Registry.Count - 1 downto 0 do
begin
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];

begin
for i := Registry.Count - 1 downto 0 do
begin
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 do
with TClassInfo(Registry[i]) do
if ClassType = AClass then
begin
if ClassID <> AnID then
raise 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 := nil
else
begin
P := StrAlloc(L + 1);
ReadBuffer(P[0], L);
P[L] := #0;
StrRead := P;
end;
end;

procedure TCompatibleStream.StrWrite(P: PChar);

var
L: Word;

begin
if P = nil then
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.





Опубликовал Kest November 14 2008 00:44:35 · 0 Комментариев · 7069 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Нет комментариев.
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Delphi 2006 - Спр...
Email
Песочные часы
Dbgridpack
Х. М. Дейтел, П. ...
Java в примерах -...
Приемы программир...
Delphi. Учимся на...
Профессиональное ...
iComm v.6.1 - выв...
SynEdit
Delphi 2005 Учимс...
Экспорт базы данн...
HtmlLerz PRO
Assembler. Учебни...
DateEdit
TDBF
Приложение Клиент...
Работа с базами д...
Autorunner

Топ загрузок
Приложение Клие... 100470
Delphi 7 Enterp... 87103
Converter AMR<-... 20078
GPSS World Stud... 12856
Borland C++Buil... 11848
Borland Delphi ... 8604
Turbo Pascal fo... 7039
Visual Studio 2... 4999
Калькулятор [Ис... 4803
FreeSMS v1.3.1 3542
Случайные статьи
Фильтрация таблиц ...
Использование бито...
• Computer Configu...
Два всадника на од...
Bases for Allsubmi...
12.2. Одно из решений
Алгоритмы и способ...
Практические реком...
Интерфейс UNIX
Пользователь может...
Процесс нагрева во...
Стандартные логиче...
БЛОКИ, ОПИСЫВАЮЩИЕ...
Пример установки н...
NUKE. Факты из ист...
Однокоренная иерархия
Класс TImage
Г-слоя в физике пл...
Элементы управлени...
Что такое процессо...
Разработка чужими ...
все фильтры IPSec ...
Включение датчика NFC
Плотность изображе...
Средства обработки...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?