Навигация
Главная
Поиск
Форум
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
21 ошибка прогр... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Имитационное мо... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Реклама
Сейчас на сайте
Гостей: 15
На сайте нет зарегистрированных пользователей

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

Сравнение двух бинарных деревьев на Turbo Pascal + отчет
Диплом RSA, ЭЦП, сертификаты, шифрование на C#
Моделирование работы обрабатывающего участка цеха в GPSS

Группировка и разгруппировка потоков
{ **** 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 12:27:03 · 0 Комментариев · 7454 Прочтений · Для печати

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


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



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

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

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

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

Пароль



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

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

Случайные загрузки
С/C++ Программиро...
Apollovcl61
Советы по Delphi
База для Allsubmi...
C++ Builder: Книг...
Язык программиров...
Bitmap [для кнопок]
Библия хакера 2. ...
Программирование ...
3D Октаэдр
Отключение и вклю...
Swing. Эффектные...
index.php + мод ...
Globus VCL Extent...
Панель поиска
VFW
Пятнашки и крести...
В.Понамарев - COM...
Платформа програм...
ATComponents

Топ загрузок
Приложение Клие... 100772
Delphi 7 Enterp... 97809
Converter AMR<-... 20261
GPSS World Stud... 17014
Borland C++Buil... 14189
Borland Delphi ... 10267
Turbo Pascal fo... 7372
Калькулятор [Ис... 5972
Visual Studio 2... 5206
Microsoft SQL S... 3661
Случайные статьи
Хотя компьютеры, в...
Структура экспертн...
Ключевые факты об ...
Заключение
9. Инициализация в...
Букмекерская конто...
Регистрация нового...
Линии не имели общ...
Компания Intel
Строковые потоки
Маршрутизатор обра...
Начать играть в кл...
Интернет-соединени...
ей право сбрасыват...
Сегодня ночью я сп...
Закрытые данные ка...
Используем базу да...
Язык Ada и военный...
Ограничения на дли...
Формирование струк...
Исследование внутр...
No inherited metho...
количество элемент...
Ссылки IPC
ОБЛАСТИ ВИДИМОСТИ ...
Статистика



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


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