Навигация
Главная
Поиск
Форум
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
Создание отчето... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Модуль Forms 65535
Имитационное мо... 61093
Реклама
Сейчас на сайте
Гостей: 4
На сайте нет зарегистрированных пользователей

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

База данных междугородних телефонных разговоров на Delphi
Метод конечных разностей для интерполяции/экстраполяции на Delphi
Программа тестирования и обучающая программа по математике на Turbo Pasc...

Реклама



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

ПОДПИСЫВАЙСЯ на канал о программировании
Группировка и разгруппировка потоков
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Группировка/разгруппировка потоков

При написании распределённых приложений, зачастую возникает проблема
в хранении и передаче по сети разнородных данных. Данный класс представляет
собой поток (TStream) позволяющий включать в себя множество других потоков.
Таким образом становится возможным накопить в одном блоке множество
разных данных и управлять ими как единым целым. Дополнительное удобство -
механизм, совмещающий _RecordSet (ADODB) и TStream.

Зависимости: SysUtils, Classes, ADODB, ADOInt, ComObj, Variants
Автор: Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Москва
Copyright: Delirium (Master BRAIN)
Дата: 6 декабря 2002 г.
***************************************************** }

unit StreamDirector;

interface

uses
SysUtils, Classes, ADODB, ADOInt, ComObj, Variants;

const
NamesSize = 128;
ErrorStreamIndex = 4294967295;
type
// Элемент группы
TStreamDescriptor = record
Name: string[NamesSize];
Value: TMemoryStream;
end;
// Компонент StreamDirector
TStreamDirector = class;
TStreamDirector = class(TComponent)
private
FDes: array of TStreamDescriptor;

protected
function GetStream(AIndex: Cardinal): TStreamDescriptor;
procedure SetStream(AIndex: Cardinal; const Value: TStreamDescriptor);
function GetCount: Cardinal;
procedure SetCount(ACount: Cardinal);
function GetDStream: TMemoryStream;
procedure SetDStream(Value: TMemoryStream);

public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;

// Добавить поток в группу потоков
procedure AddFromStream(AName: string; AStream: TStream);
// Добавить файл в группу потоков
procedure AddFromFile(AName, AFileName: string);
// Добавить текст в группу потоков
procedure AddFromStrings(AName: string; AStrings: TStrings);
// Получить текст из группы потоков
function GetStrings(AIndex: Cardinal): TStrings;
// Добавить _RecordSet в группу потоков
procedure AddFromRecordSet(AName: string; ARecordSet: _RecordSet);
// Получить _RecordSet из группы потоков
function GetRecordSet(AIndex: Cardinal): _RecordSet;
// Найти иденитфикатор по имени, еcли не найден - ErrorStreamIndex
function IndexOfStreamName(AName: string): Cardinal;
// Загрузить поток с группой из файла
procedure DirectLoadFromFile(AFileName: string);
// Получить поток элемента группы
property Streams[AIndex: Cardinal]: TStreamDescriptor read GetStream write
SetStream;
// Кол-во элементов в группе
property StreamCount: Cardinal read GetCount write SetCount;
// Получить поток, содержащий группу
property DirectStream: TMemoryStream read GetDStream write SetDStream;
published

end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Master Components', [TStreamDirector]);
end;

constructor TStreamDirector.Create(Owner: TComponent);
begin
inherited Create(Owner);
SetLength(FDes, 0);
end;

destructor TStreamDirector.Destroy;
var
i: Cardinal;
begin
if StreamCount > 0 then
for i := 0 to StreamCount - 1 do
if Streams[i].Value <> nil then
Streams[i].Value.Destroy;
inherited Destroy;
end;

function TStreamDirector.GetStream(AIndex: Cardinal): TStreamDescriptor;
begin
Result.Name := '';
Result.Value := nil;
if AIndex < StreamCount then
begin
Result.Name := FDes[AIndex].Name;
Result.Value := FDes[AIndex].Value;
if Result.Value <> nil then
Result.Value.Position := 0;
end;
end;

procedure TStreamDirector.SetStream(AIndex: Cardinal; const Value:
TStreamDescriptor);
begin
if AIndex < StreamCount then
begin
FDes[AIndex].Name := FDes[AIndex].Name;
FDes[AIndex].Value := FDes[AIndex].Value;
end;
end;

function TStreamDirector.GetCount: Cardinal;
begin
Result := Length(FDes);
end;

procedure TStreamDirector.SetCount(ACount: Cardinal);
var
i, n: Cardinal;
tmp: TStreamDescriptor;
begin
n := StreamCount;
if ACount < n then
begin
for i := ACount - 1 to n - 1 do
if Streams[i].Value <> nil then
Streams[i].Value.Free;
SetLength(FDes, ACount);
end
else
begin
SetLength(FDes, ACount);
tmp.Name := '';
tmp.Value := nil;
for i := n - 1 to ACount - 1 do
Streams[i] := tmp;
end;
end;

procedure TStreamDirector.AddFromStream(AName: string; AStream: TStream);
begin
StreamCount := StreamCount + 1;
FDes[StreamCount - 1].Name := AName;
FDes[StreamCount - 1].Value := TMemoryStream.Create;
TMemoryStream(FDes[StreamCount - 1].Value).LoadFromStream(AStream);
FDes[StreamCount - 1].Value.Position := 0;
end;

procedure TStreamDirector.AddFromFile(AName, AFileName: string);
begin
StreamCount := StreamCount + 1;
FDes[StreamCount - 1].Name := AName;
FDes[StreamCount - 1].Value := TMemoryStream.Create;
TMemoryStream(FDes[StreamCount - 1].Value).LoadFromFile(AFileName);
FDes[StreamCount - 1].Value.Position := 0;
end;

procedure TStreamDirector.AddFromStrings(AName: string; AStrings: TStrings);
begin
StreamCount := StreamCount + 1;
FDes[StreamCount - 1].Name := AName;
FDes[StreamCount - 1].Value := TMemoryStream.Create;
AStrings.SaveToStream(FDes[StreamCount - 1].Value);
FDes[StreamCount - 1].Value.Position := 0;
end;

function TStreamDirector.GetStrings(AIndex: Cardinal): TStrings;
begin
Result := TStringList.Create;
Result.LoadFromStream(Streams[AIndex].Value);
end;

procedure TStreamDirector.AddFromRecordSet(AName: string; ARecordSet:
_RecordSet);
var
adoStream: OleVariant;
St: TStrings;
begin
// Сначала ADODB.RecordSet -> ADODB.Stream через XML
adoStream := CreateOLEObject('ADODB.Stream');
Variant(ARecordSet).Save(adoStream, adPersistXML);
// Теперь XML -> TStrings
St := TStringList.Create;
St.Text := adoStream.ReadText(adoStream.Size);
// Ну а теперь всё просто
AddFromStrings(AName, St);
// Чищу память
St.Free;
adoStream := UnAssigned;
end;

function TStreamDirector.GetRecordSet(AIndex: Cardinal): _RecordSet;
var
adoStream: OleVariant;
St: TStrings;
begin
// Получаю TStrings из потока
St := GetStrings(AIndex);
// Помещаю XML из TStrings в ADODB.Stream
adoStream := CreateOLEObject('ADODB.Stream');
adoStream.Open;
adoStream.WriteText(St.Text);
adoStream.Position := 0;
// Создаю RecordSet, заполняю его из ADODB.Stream
Result := CreateOLEObject('ADODB.RecordSet') as _RecordSet;
Result.CursorLocation := adUseClient;
Result.Open(adoStream, EmptyParam, adOpenStatic, adLockOptimistic,
adOptionUnspecified);
// Чищу память
adoStream := UnAssigned;
St.Free;
end;

type
TWriteDirector = record
Name: string[NamesSize];
Size: Cardinal;
end;

function TStreamDirector.GetDStream: TMemoryStream;
var
i, j: Cardinal;
WD: TWriteDirector;
begin
// С пустым работать не буду
Result := nil;
if StreamCount = 0 then
exit;
// Не пустой
Result := TMemoryStream.Create;
// Кол-во потоков
i := StreamCount;
Result.Write(i, SizeOf(i));
// Названия и размеры
for i := 0 to StreamCount - 1 do
begin
// Вычищаю мусор из названий
SetLength(WD.Name, NamesSize);
for j := 1 to NamesSize do
WD.Name[j] := ' ';
// Пишу дескрипторы
WD.Name := Streams[i].Name;
if Streams[i].Value <> nil then
WD.Size := Streams[i].Value.Size
else
WD.Size := 0;
Result.Write(WD, SizeOf(WD));
end;
// Значения
for i := 0 to StreamCount - 1 do
if Streams[i].Value <> nil then
begin
Streams[i].Value.Position := 0;
Result.CopyFrom(Streams[i].Value, Streams[i].Value.Size);
end;
// Ok
Result.Position := 0;
end;

procedure TStreamDirector.SetDStream(Value: TMemoryStream);
var
i, n: Cardinal;
WDs: array of TWriteDirector;
SD: TStreamDescriptor;
begin
Value.Position := 0;
// Кол-во потоков
Value.Read(n, SizeOf(n));
SetLength(WDs, n);
SetLength(FDes, n);
// Названия и размеры
for i := 0 to StreamCount - 1 do
begin
Value.Read(WDs[i], SizeOf(WDs[i]));
FDes[i].Name := WDs[i].Name;
end;
// Значения
for i := 0 to StreamCount - 1 do
begin
SD.Name := FDes[i].Name;
SD.Value := TMemoryStream.Create;
SD.Value.CopyFrom(Value, WDs[i].Size);
FDes[i] := SD;
FDes[i].Value.Position := 0;
end;
end;

function TStreamDirector.IndexOfStreamName(AName: string): Cardinal;
var
i: Cardinal;
begin
Result := ErrorStreamIndex;
for i := StreamCount - 1 downto 0 do
if AnsiUpperCase(AName) = AnsiUpperCase(FDes[i].Name) then
Result := i;
end;

procedure TStreamDirector.DirectLoadFromFile(AFileName: string);
var
tmp: TMemoryStream;
begin
tmp := TMemoryStream.Create;
tmp.LoadFromFile(AFileName);
DirectStream := tmp;
tmp.Destroy;
end;

end.

// Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
begin
StreamDirector1.AddFromRecordSet('RecordSet1', ADOQuery1.Recordset);
StreamDirector1.DirectStream.SaveToFile('c:\test');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
StreamDirector1.DirectLoadFromFile('c:\test');
ADOQuery2.Recordset :=
StreamDirector1.GetRecordSet(StreamDirector1.IndexOfStreamName('RecordSet1'));
end;
Опубликовал Kest Ноябрь 13 2008 15:27:03 · 0 Комментариев · 6437 Прочтений · Для печати

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


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



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

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

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

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

Пароль



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

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

Случайные загрузки
PDJ Scrollers
Х. М. Дейтел, П. ...
Род Стивенс. Delp...
NotePad Pro [Исхо...
Abbrevia
Программирование ...
DateEdit
Время загрузки ...
Советы по Delphi
EditButton
Книга по Delphi (...
3D Октаэдр
PHP: настольная к...
Распознавание иде...
Разработка клиент...
IMtale
Пример создания W...
Платформа програм...
Delphi 2006 - Спр...
База Allsubmitter...

Топ загрузок
Приложение Клие... 100537
Delphi 7 Enterp... 92345
Converter AMR<-... 20106
GPSS World Stud... 15688
Borland C++Buil... 13223
Borland Delphi ... 9238
Turbo Pascal fo... 7118
Калькулятор [Ис... 5243
Visual Studio 2... 5039
FreeSMS v1.3.1 3562
Случайные статьи
Прозрачные команды...
Организация ввода-...
Организация ввода-...
Label Identifier e...
Телевизионные сист...
Unknown Identifier
Персептрону. Пробл...
Виджеты домашнего ...
Убрать копирайт в ...
Так, пользователь ...
Использование кома...
Язык С: определени...
Линии серий (рядов)
Первые языки прогр...
Запрос дерева со С...
Важность памяти
Миссия II. FACILIT...
Подготовка удаленн...
ГЛАВА 7. ЕЩЕ НЕСК...
5.1.1. Вывод термов
Программирование к...
Защита изображений...
Адреса, локальные ...
Масла Meguin
Сегментные регистры
Статистика



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


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