MemTable с поддержкой Blob и Мемо

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

MemTable с поддержкой Blob и Мемо

Сообщение MaratIsk » 25.04.2010 11:46:44

не знает ли кто сабж?
MaratIsk
постоялец
 
Сообщения: 121
Зарегистрирован: 20.08.2009 18:15:20

Re: MemTable с поддержкой Blob и Мемо

Сообщение Vadim » 25.04.2010 12:21:36

MaratIsk
Знаем. Называется TDBF. Этот компонент может брать данные как из файлов, так и хранить их только в ОЗУ, как и MemTable.
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: MemTable с поддержкой Blob и Мемо

Сообщение alexs » 25.04.2010 22:46:51

RxMemTable - должен всё содержать
Аватара пользователя
alexs
долгожитель
 
Сообщения: 4064
Зарегистрирован: 15.05.2005 23:17:07
Откуда: г.Ставрополь

Re: MemTable с поддержкой Blob и Мемо

Сообщение MaratIsk » 26.04.2010 07:33:38

RxMemTable не содержит поддержку blob даже в версиях для delphi

Добавлено спустя 1 час 4 минуты 44 секунды:
ошибся - rxMemoryData для Delphi поддерживает BLOB и MEMO
MaratIsk
постоялец
 
Сообщения: 121
Зарегистрирован: 20.08.2009 18:15:20

Re: MemTable с поддержкой Blob и Мемо

Сообщение alexs » 26.04.2010 19:31:50

и у нас есть.
Аватара пользователя
alexs
долгожитель
 
Сообщения: 4064
Зарегистрирован: 15.05.2005 23:17:07
Откуда: г.Ставрополь

Re: MemTable с поддержкой Blob и Мемо

Сообщение MaratIsk » 27.04.2010 07:35:12

верю на слово - придется перепроверить свой код загрузки из стрима
MaratIsk
постоялец
 
Сообщения: 121
Зарегистрирован: 20.08.2009 18:15:20

Re: MemTable с поддержкой Blob и Мемо

Сообщение Timid » 27.04.2010 09:28:37

MaratIsk писал(а):верю на слово - придется перепроверить свой код загрузки из стрима


А опубликовать (включить в модуль) как код загрузки-выгрузки в поток для RxMemoryData не сможете? Есть ли вообще пример универсального решения?
Чтобы можно было читать-писать данные в файл или поток.
Timid
постоялец
 
Сообщения: 290
Зарегистрирован: 21.11.2007 21:33:15

Re: MemTable с поддержкой Blob и Мемо

Сообщение MaratIsk » 29.04.2010 10:44:25

Код: Выделить всё
function FieldTypeFromString(const s: string): TFieldType;
begin
  if s = 'Unknown' then begin Result := ftUnknown; Exit; end;
  if s = 'String' then begin Result := ftString; Exit; end;
  if s = 'SmallInt' then begin Result := ftSmallInt; Exit; end;
  if s = 'Integer' then begin Result := ftInteger; Exit; end;
  if s = 'Word' then begin Result := ftWord; Exit; end;
  if s = 'Boolean' then begin Result := ftBoolean; Exit; end;
  if s = 'Float' then begin Result := ftFloat; Exit; end;
  if s = 'Currency' then begin Result := ftCurrency; Exit; end;
  if s = 'BCD' then begin Result := ftBCD; Exit; end;
  if s = 'Date' then begin Result := ftDate; Exit; end;
  if s = 'Time' then begin Result := ftTime; Exit; end;
  if s = 'DateTime' then begin Result := ftDateTime; Exit; end;
  if s = 'Bytes' then begin Result := ftBytes; Exit; end;
  if s = 'VarBytes' then begin Result := ftVarBytes; Exit; end;
  if s = 'AutoInc' then begin Result := ftAutoInc; Exit; end;
  if s = 'Blob' then begin Result := ftBlob; Exit; end;
  if s = 'Memo' then begin Result := ftMemo; Exit; end;
  if s = 'Graphic' then begin Result := ftGraphic; Exit; end;
  if s = 'FmtMemo' then begin Result := ftFmtMemo; Exit; end;
  if s = 'ParadoxOle' then begin Result := ftParadoxOle; Exit; end;
  if s = 'dBaseOle' then begin Result := ftdBaseOle; Exit; end;
  if s = 'TypedBinary' then begin Result := ftTypedBinary; Exit; end;
  if s = 'Cursor' then begin Result := ftCursor; Exit; end;
  if s = 'FixedChar' then begin Result := ftFixedChar; Exit; end;
  if s = 'WideString' then begin Result := ftWideString; Exit; end;
  if s = 'LargeInt' then begin Result := ftLargeInt; Exit; end;
  if s = 'ADT' then begin Result := ftADT; Exit; end;
  if s = 'Array' then begin Result := ftArray; Exit; end;
  if s = 'Reference' then begin Result := ftReference; Exit; end;
  if s = 'DataSet' then begin Result := ftDataSet; Exit; end;
  if s = 'OraBlob' then begin Result := ftOraBlob; Exit; end;
  if s = 'OraClob' then begin Result := ftOraClob; Exit; end;
  if s = 'Variant' then begin Result := ftVariant; Exit; end;
  if s = 'Interface' then begin Result := ftInterface; Exit; end;
  if s = 'Guid' then begin Result := ftGuid; Exit; end;
end;

procedure DataSetToStream(DataSet: TRxMemoryData; Stream: TStream);
Var
   X          : Integer;
   Book       : TBookmark;
   Writer     : TWriter;
   Current    : Integer;
   Total      : Integer;
Begin
  with DataSet do begin
    if IsEmpty Then Exit;
    Book         := GetBookmark;
    Try
     DisableControls;
     Writer := TWriter.Create(Stream, 16384);
     Write(FilerSignature, SizeOf(FilerSignature));
     Try
     //*************************************************** Write Structure
     Writer.WriteListBegin;
     For X:=0 to FieldCount-1 do
         Begin
          Application.ProcessMessages;
          if Fields[X].FieldKind = fkData then
             Begin
              Writer.WriteString(Fields[X].FieldName);
              Writer.WriteString(FieldTypeNames[Fields[X].DataType]);
              Writer.WriteInteger(Fields[X].Size);
             End;
         end;
     Writer.WriteListEnd;

     //******************************************************** Write Data
     Total  := RecordCount-1;
     Current:=0;
     Writer.WriteListBegin;
     First;
     While Not EOF do
       Begin
        For X:=0 to FieldCount-1 do
          Begin
            Application.ProcessMessages;
            if Fields[X].FieldKind = fkData Then
               Begin
                 Case Fields[X].DataType of
                      ftBoolean   : Writer.WriteBoolean(Fields[X].AsBoolean);
                      ftSmallInt  ,
                      ftInteger   ,
                      ftWord      ,
                      ftAutoInc   : Writer.WriteInteger(Fields[X].AsInteger);
                      ftFloat     : Writer.WriteFloat(Fields[X].AsFloat);
                      ftBCD       ,
                      ftCurrency  : Writer.WriteFloat(Fields[X].AsCurrency);
                      ftDate      ,
                      ftTime      ,
                      ftDateTime  : Writer.WriteFloat(Fields[X].AsFloat);
                 Else
                      Writer.WriteString(Fields[X].AsString);
                 End;
               End;
          End;
        Inc(Current);
        Next;
       End;
     Writer.WriteListEnd;
     Finally
      Writer.Free;
     End;
    Finally
      GotoBookmark(Book);
      EnableControls;
      FreeBookmark(Book);
    End;
  end; //
end;

procedure DataSetFromStream(DataSet: TRxMemoryData; Stream: TStream);
Var
  Reader       : TReader;
  FieldName    : String;
  DataTypeName : String;
  FSize        : Integer;
  I            : Integer;
  X            : Integer;
  Field        : TField;
  FNames       : TStringList;
  OK           : Boolean;
  Current      : LongInt;
  KbmFileVers  : Integer;
  Signature    : Longint;
begin
  with DataSet do begin
    Close;
    FieldDefs.Clear;
    Reader := TReader.Create(Stream, 16384);
    FNames := TStringList.Create;
    Try
     DisableControls;
     Reader.Read(Signature, SizeOf(Signature));
     if Signature <> Longint(FilerSignature) then raise Exception.Create('РқРөРІРөСҖРҪый С„РҫСҖмат файла');
     if (Reader.NextValue = vaList) Then KbmFileVers := 100
     Else KbmFileVers := Reader.ReadInteger;
     //************************************************************ Read Structure
     Reader.ReadListBegin;
       While (Not Reader.EndOfList) Do
        Begin
         Application.ProcessMessages;
         FieldName    := Reader.ReadString;
         DataTypeName := Reader.ReadString;
         FSize     := Reader.ReadInteger;
         if (KbmFileVers >= 250) Then Reader.ReadString;
         FNames.Add(FieldName);
         FieldDefs.Add(FieldName, FieldTypeFromString(DataTypeName), FSize, FALSE);
       End;

       //DataSet.CreateTable;
       //DataSet.Create;
       Open;
     Reader.ReadListEnd;
     //***************************************************************** Read Data
     Last;
     Reader.ReadListBegin;
     Current := 0;
     While (NOT Reader.EndOfList) do
      Begin
       OK := False;
       For X :=0 to FNames.Count-1 do
           Begin
            Field := FindField(FNames.Strings[X]);
            if (Field <> Nil) Then
               Begin
                 if NOT OK Then
                    Begin
                      OK := True;
                      Append;
                    End;
                 Case Field.DataType of
                      ftBoolean  : Field.AsBoolean  := Reader.ReadBoolean;
                      ftSmallInt ,
                      ftInteger  ,
                      ftWord     ,
                      ftAutoInc  : Field.AsInteger  := Reader.ReadInteger;
                      ftFloat    : Field.AsFloat    := Reader.ReadFloat;
                      ftBCD,
                      ftCurrency : Field.AsCurrency := Reader.ReadFloat;
                      ftDate     ,
                      ftTime     ,
                      ftDateTime : Field.AsFloat    := Reader.ReadFloat;
                 Else
                      Begin
                        Field.AsString   := Reader.ReadString;
                      End;
                 End;
               End;
           End;
       if OK Then Post;
       Inc(Current);
      End;
     Reader.ReadListEnd;
     First;
    Finally
     Reader.Free;
     FNames.Free;
     EnableControls;
    End;
  end; // with
End;


Добавлено спустя 2 минуты 31 секунду:
в
procedure DataSetToStream(DataSet: TRxMemoryData; Stream: TStream);
можно обойтись параметром TDataSet для универсальности

а вот
procedure DataSetFromStream(DataSet: TRxMemoryData; Stream: TStream);
придется подстраивать под конкретный мемдатасет
MaratIsk
постоялец
 
Сообщения: 121
Зарегистрирован: 20.08.2009 18:15:20


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 224

Рейтинг@Mail.ru
cron