Группировка и разгруппировка потоковDelphi , Компоненты и Классы , ПотокиГруппировка и разгруппировка потоков
Автор: Delirium { **** 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; Статья Группировка и разгруппировка потоков раздела Компоненты и Классы Потоки может быть полезна для разработчиков на Delphi и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |