Навигация
Главная
Поиск
Форум
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
Модуль Forms 62784
Создание отчето... 62766
ТЕХНОЛОГИИ ДОСТ... 59300
Пример работы с... 58009
Имитационное мо... 54678
Реклама
Сейчас на сайте
Гостей: 7
На сайте нет зарегистрированных пользователей

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

Моделирование литейного цеха на GPSS + Пояснительная записка
Моделирование станции технического обслуживания на GPSS + Отчет
Меры близости на векторах в Delphi + Блок схемы

Реклама



Подписывайся на 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 November 13 2008 15:27:03 · 0 Комментариев · 6132 Прочтений · Для печати

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


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



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

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

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

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

Пароль



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

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

Случайные загрузки
Простой текстовый...
Программирование ...
XPButtons
Алгоритмы шифрова...
Delphi 6/7 базы д...
Calendar
Animation Effect ...
Советы по Delphi
C++ для начинающих
PHP 5. Полное рук...
WAP версия сайта
Globus VCL Extent...
Андрей Боровский....
Crypt32
Работа с картотеками
Сапёр
Панель "Случайное...
THttpScan v4.1
Песочные часы
FreeSMS v1.3.1

Топ загрузок
Приложение Клие... 100420
Delphi 7 Enterp... 84880
Converter AMR<-... 20061
GPSS World Stud... 11934
Borland C++Buil... 11401
Borland Delphi ... 8362
Turbo Pascal fo... 7007
Visual Studio 2... 4983
Калькулятор [Ис... 4618
FreeSMS v1.3.1 3529
Случайные статьи
Как заполнить табл...
Коллективное владение
Сайты, посвященные...
Ожидавшиеся распре...
Разработка любител...
Алгоритм RC6
Дыpы в Win95/WinNT
Использование DLL ...
Свойства информаци...
Подсистема STREAMS...
Windows 2000, долж...
Числа и серьезные ...
Основанные принцип...
11.1. Простые про...
Поддержка последов...
Шаблоны документов...
URL целевой страницы
Генерация HTTP зап...
Invalid ordering o...
и режим ядра гаран...
Задача о шахматах....
Этот элемент управ...
Проверка грамматик...
Руководство для ра...
Настройка дизайн-т...
Статистика



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


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