Группировка и разгруппировка потоков
Автор: Delirium
WEB-сайт: http://delphibase.endimus.com
{ **** 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 ;
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Группировка и разгруппировка потоков", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!