Модератор: Модераторы
MaratIsk писал(а):верю на слово - придется перепроверить свой код загрузки из стрима
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;
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 224