⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dxdatasetbintree.pas

📁 Well known and usefull component for delphi 7
💻 PAS
📖 第 1 页 / 共 4 页
字号:
         end;
      end;
      else begin
         if RecordCount=0 then exit;
         GetFieldData(Field,@BlobSpot);
         Result:=FBlobList.GetBlob(BlobSpot,Field.FieldNo);
      end;
   end;
   if Result<>nil then Result.Position:=0;
end;

procedure TDXDataSetBinaryTree.AddField(FieldName:String;FType:TFieldType;FSize:Integer;FRequired:Boolean);
begin
   FieldDefs.Add(FieldName,FType,FSize,FRequired);
end;

procedure TDXDataSetBinaryTree.SaveToStream(Stream: TMemoryStream; Append :Boolean);
var Cnt, i              :Integer;
    TheSize             :Cardinal;
    StreamId            :PChar;
    TmpStream           :TMemoryStream;
    BlobSize, BlobCnt   :Integer;
    Ws:String;
    fB:Byte;

begin
(*
   If Not Active then Open; // ozz
   If (State in dsEditModes) then Post;
   TmpStream:=TMemoryStream.Create;
   if not Append then Stream.Clear;
try
   GetMem(StreamId,Length(DXDatabaseSignature));
try
   StrPCopy(StreamId,DXDatabaseSignature);
   Stream.WriteBuffer(StreamId^,Length(DXDatabaseSignature));
finally
   FreeMem(StreamId,Length(DXDatabaseSignature));
end;
   Cnt:=FDataList.RecordSize;
   Stream.WriteBuffer(Cnt,DXIntSize);
   Cnt:=FieldDefs.Count;
   Stream.WriteBuffer(Cnt,DXIntSize);
   Ws:='';
   for i:=0 to FieldDefs.Count-1 do begin
      // Save the Name
      Ws:=Chr(Length(FieldDefs.Items[i].Name))+FieldDefs.Items[i].Name;
      case FieldDefs.Items[i].Datatype of
         ftString:Ws:=Ws+#1;
         ftBoolean:Ws:=Ws+#2;
         ftWord:Ws:=Ws+#3;
         ftSmallInt:Ws:=Ws+#4;
         ftFloat:Ws:=Ws+#5;
         ftCurrency:Ws:=Ws+#6;
         ftDate:Ws:=Ws+#7;
         ftTime:Ws:=Ws+#8;
         ftDateTime:Ws:=Ws+#9;
         ftAutoInc:Ws:=Ws+#10;
         ftFmtMemo:Ws:=Ws+#11;
         ftParadoxOle:Ws:=Ws+#12;
         ftDBaseOle:Ws:=Ws+#13;
         ftInteger:Ws:=Ws+#14;
         ftBlob:Ws:=Ws+#15;
         ftMemo:Ws:=Ws+#16;
         ftVarBytes:Ws:=Ws+#17;
         ftGraphic:Ws:=Ws+#18;
{$IFNDEF VER100}
         ftDataSet:Ws:=Ws+#99;
{$ENDIF}
      End;
      Stream.WriteBuffer(Ws[1],Length(Ws));
      Ws:=#32#32#32#32#32#32#32#32;
      Cnt:=FieldDefs.Items[i].Size; // word
      FastMove(Cnt,Ws[1],DXIntSize);
      Cnt:=FieldDefs.Items[i].Precision;
      FastMove(Cnt,Ws[5],DXIntSize);
      Stream.WriteBuffer(Ws[1],Length(Ws));
      fB:=0;
{$IFNDEF VER100}
      if faHiddenCol in FieldDefs.Items[i].Attributes then SetByteBit(fB,1,true);
      if DB.faReadOnly in FieldDefs.Items[i].Attributes then SetByteBit(fB,2,true);
      if faRequired in FieldDefs.Items[i].Attributes then SetByteBit(fB,3,true);
      if faLink in FieldDefs.Items[i].Attributes then SetByteBit(fB,4,true);
      if faUnnamed in FieldDefs.Items[i].Attributes then SetByteBit(fB,5,true);
      if faFixed in FieldDefs.Items[i].Attributes then SetByteBit(fB,6,true);
{$ENDIF}
      Stream.WriteBuffer(fB,1);
   End;
   Cnt:=FDataList.Count;
   TheSize:=FDataList.DataStream.Size;
   BlobCnt:=FBlobList.Count;
   Stream.WriteBuffer(Cnt,DXIntSize);
   Stream.WriteBuffer(TheSize,DXIntSize);
{   FDataList.DataStream.Position:=0;
   Stream.CopyFrom(FDataList.DataStream,FDataList.DataStream.Size);
}
   for i:=0 to FDataList.Count-1 do begin
      FDataList.DataStream.Position:=FDataList.Items[i].DataOffSet;
      Stream.CopyFrom(FDataList.DataStream, FRecordSize);
   end;

   Stream.WriteBuffer(BlobCnt,DXIntSize);

   if BlobCnt>0 then begin
      FBlobList.SaveToStream(TmpStream);
      BlobSize:=TmpStream.Size;
      Stream.WriteBuffer(BlobSize,DXIntSize);
      Stream.CopyFrom(TmpStream,TmpStream.Size);
   end;
   Stream.Position:=0;
finally
   TmpStream.Free;
end;
*)
end;

procedure TDXDataSetBinaryTree.SaveToFile(Filename:String);
Var
   MemStream:TMemoryStream;

Begin
   If FileName='' then begin
      FileName:=fDatabaseName+fTableName;
   End;
   If FileName='' then Exit
   Else begin
      fDatabaseName:=ExtractFilePath(FileName);
      fTableName:=ExtractFileName(FileName);
   End;
   MemStream:=TMemoryStream.Create;
   SaveToStream(MemStream,False);
   MemStream.SaveToFile(FileName);
   MemStream.Free;
End;

procedure TDXDataSetBinaryTree.LoadFromStream(Stream: TStream);
var AStream           :TMemoryStream;
    Cnt, i            :Integer;
    TheSize           :Cardinal;
{$IFDEF VER100}
    FieldName:String;
    DataType:TFieldType;
    FieldSize:Integer;
{$ELSE}
    FieldDef:TFieldDef;
{$ENDIF}
    StreamId          :String;
    BlobSize, BlobCnt :Integer;
    Loop:Integer;
    Len:Byte;
    Ws:String;

begin
(*
   DisableControls;
   Close;
   If Not Assigned(FDataList) then Begin
      If FUseShareDataList then Begin
         If Assigned(FNeedDataList) then
            FNeedDataList(FDataList);
      // fire event to associate FDataList with Shared one.
      End
      Else FDataList:=TDXDataList.Create;
   End;
   Setlength(StreamID,Length(DXDatabaseSignature));
try
   Stream.Seek(0,0); // 3-1-2002
   Stream.ReadBuffer(StreamID[1],Length(DXDatabaseSignature));
   if StreamID<>DXDatabaseSignature then
{$IFDEF VER100}
         DatabaseError(SNotValidSource);
{$ELSE}
         DatabaseError(SNotValidSource,Self);
{$ENDIF}
finally
end;
   Stream.ReadBuffer(Cnt,DXIntSize);
   FDataList.RecordSize:=Cnt;
   FRecordSize:=Cnt;
   FieldDefs.Clear;
   Stream.ReadBuffer(Loop,DXIntSize);
   for i:=0 to Loop-1 do begin
{$IFNDEF VER100}
      FieldDef:=FieldDefs.AddFieldDef;
      Stream.ReadBuffer(Len,1);
      SetLength(Ws,Len);
      Stream.ReadBuffer(Ws[1],Len);
      FieldDef.Name:=Ws;
      Stream.ReadBuffer(Len,1);
      case Len of
         1:FieldDef.DataType:=ftString;
         2:FieldDef.DataType:=ftBoolean;
         3:FieldDef.DataType:=ftWord;
         4:FieldDef.DataType:=ftSmallInt;
         5:FieldDef.DataType:=ftFloat;
         6:FieldDef.DataType:=ftCurrency;
         7:FieldDef.DataType:=ftDate;
         8:FieldDef.DataType:=ftTime;
         9:FieldDef.DataType:=ftDateTime;
         10:FieldDef.DataType:=ftAutoInc;
         11:FieldDef.DataType:=ftFmtMemo;
         12:FieldDef.DataType:=ftParadoxOle;
         13:FieldDef.DataType:=ftDBaseOle;
         14:FieldDef.DataType:=ftInteger;
         15:FieldDef.DataType:=ftBlob;
         16:FieldDef.DataType:=ftMemo;
         17:FieldDef.DataType:=ftVarBytes;
         18:FieldDef.DataType:=ftGraphic;
         99:FieldDef.DataType:=ftDataSet;
      End;
      Ws:=#32#32#32#32#32#32#32#32;
      Stream.ReadBuffer(Ws[1],8);
      FastMove(Ws[1],Cnt,DXIntSize);
      FieldDefs.Items[i].Size:=Cnt;
      FastMove(Ws[5],Cnt,DXIntSize);
      FieldDefs.Items[i].Precision:=Cnt;
      Stream.ReadBuffer(Len,1);
      FieldDefs.Items[i].Attributes:=[];
      If GetByteBit(Len,1) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[faHiddenCol];
      If GetByteBit(Len,2) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[db.faReadOnly];
      If GetByteBit(Len,3) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[faRequired];
      If GetByteBit(Len,4) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[faLink];
      If GetByteBit(Len,5) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[faUnNamed];
      If GetByteBit(Len,6) then FieldDefs.Items[i].Attributes:=
         FieldDefs.Items[i].Attributes+[faFixed];
{$ELSE}
      Stream.ReadBuffer(Len,1);
      SetLength(Ws,Len);
      Stream.ReadBuffer(Ws[1],Len);
      FieldName:=Ws;
      Stream.ReadBuffer(Len,1);
      case Len of
         2:DataType:=ftBoolean;
         3:DataType:=ftWord;
         4:DataType:=ftSmallInt;
         5:DataType:=ftFloat;
         6:DataType:=ftCurrency;
         7:DataType:=ftDate;
         8:DataType:=ftTime;
         9:DataType:=ftDateTime;
         10:DataType:=ftAutoInc;
         11:DataType:=ftFmtMemo;
         12:DataType:=ftParadoxOle;
         13:DataType:=ftDBaseOle;
         14:DataType:=ftInteger;
         15:DataType:=ftBlob;
         16:DataType:=ftMemo;
         17:DataType:=ftVarBytes;
         18:DataType:=ftGraphic;
         {1:}Else DataType:=ftString;
      End;
      Ws:=#32#32#32#32#32#32#32#32;
      Stream.ReadBuffer(Ws[1],8);
      FastMove(Ws[1],Cnt,DXIntSize);
      FieldSize:=Cnt;
      FastMove(Ws[5],Cnt,DXIntSize);
      Stream.ReadBuffer(Len,1);
      FieldDefs.Add(FieldName,DataType,FieldSize,GetByteBit(Len,3));
{$ENDIF}
   End;

   Stream.ReadBuffer(Cnt, DXIntSize);
   Stream.ReadBuffer(TheSize, DXIntSize);
   Open;
   if Cnt=0 then Begin
      EnableControls;
      exit; // No records in stream, so just exit
   End;
   FDataList.DataStream.Clear;
   SetLength(Ws,FRecordSize);
   for i:=1 to Cnt do begin
      Stream.ReadBuffer(Ws[1],FRecordSize);
      InternalAddRecord(@Ws[1],True);
   end;
//   FRecordCount:=Cnt;
   FBookmarkInfoOffset:=FRecordSize; //
   FRecBufferSize:=FRecordSize+FBookmarkInfoSize+CalcFieldsSize;
   FStartCalculated:=FRecordSize+SizeOf(TDXBookmarkInfo);
// Now do the blobs
   AStream:=TMemoryStream.Create;
try   
   Stream.ReadBuffer(BlobCnt,DXIntSize);
   if BlobCnt>0 then begin
      Stream.ReadBuffer(BlobSize, DXIntSize);
      if BlobSize>0 then begin
         AStream.CopyFrom(Stream, BlobSize);
         FBlobList.LoadFromStream(AStream);
      End;
   end;
finally
   AStream.Free;
end;
   FDataList.ResetBookmarks;
   ResetBookmarkFlags;
   Resync([]);
   First;
   EnableControls;
*)
end;

procedure TDXDataSetBinaryTree.LoadFromFile(Filename:String);
Var
   MemStream:TMemoryStream;

begin
   If FileName='' then begin
      If fDatabaseName+fTableName='' then Exit;
      FileName:=fDatabaseName+fTableName;
   End
   Else begin
      fDatabaseName:=ExtractFilePath(FileName);
      fTableName:=ExtractFileName(FileName);
   End;
   MemStream:=TMemoryStream.Create;
   if FileExists(FileName) then Begin
      MemStream.LoadFromFile(Filename);
      LoadFromStream(MemStream);
   End;
   MemStream.Free;
End;

function TDXDataSetBinaryTree.AssociateToMyDataList:TDXDataList;
Begin
   If Not FUseShareDataList then Result:=FDataList
   Else Result:=Nil;
End;

Procedure TDXDataSetBinaryTree.SetMyDataList(Value:TDXDataList);
Begin
   If FUseShareDataList then FDataList:=Value;
End;

{ TDXBlobStream }

constructor TDXBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
begin
   inherited Create;
   FField:=Field;
   FFieldNo:=FField.FieldNo;
   FModified:=False;
   FDataSet:=FField.DataSet as TDXDataSetBinaryTree;
   if Mode = bmWrite then Truncate
   else ReadBlobData;
end;

destructor TDXBlobStream.Destroy;
begin
   if FModified and (FDataSet.State in [dsEdit, dsInsert]) then
try
   FDataSet.StoreMemoryStream(FField, Self);
   FField.Modified:=True;
   FModified:=False;
   FDataSet.DataEvent(deFieldChange, Longint(FField));
except
   SysUtils.ShowException(ExceptObject, ExceptAddr);
end;
   inherited Destroy;
end;

procedure TDXBlobStream.ReadBlobData;
var TmpStream   :TMemorySTream;
    PBlobSpot   :PChar;
    BlobSpot    :Integer;

begin
   PBlobSpot:=FDataSet.GetInternalFieldData(FField);
   if PBlobSpot = nil then exit;
   FastMove(PBlobSpot^, BlobSpot,DXIntSize);
   FreeMem(PBlobSpot);
   if (BlobSpot = 0) then exit;
   TmpStream:=TMemoryStream.Create;
try
   if FDataSet.FBlobList.GetBlob(BlobSpot, FField.FieldNo)<>nil then
      TmpStream.LoadFromStream(FDataSet.FBlobList.GetBlob(BlobSpot, FField.FieldNo));
   if TmpStream.Size>0 then begin
      Position:=0;
      Self.LoadFromStream(TmpStream);
      FModified:=False;
      Position:=0;
   end;
finally
   TmpStream.Free;
end;
end;

procedure TDXBlobStream.Truncate;
begin
   Clear;
   FModified:=True;
end;

function TDXBlobStream.Write(const Buffer; Count: Integer): Longint;
var
   PBlobSpot:PChar;
   BlobSpot:Integer;
   DestBuffer:PChar;
   Null:Boolean;

begin
   Result:=inherited Write(Buffer,Count);
   FModified:=True;
   PBlobSpot:=FDataSet.DXGetFieldData(FDataSet.RecNo,FField);
   FastMove(PBlobSpot,BlobSpot,DXIntSize);
   if (FDataSet.State = dsInsert) then exit;
   FDataSet.FBlobList.SetBlob(Self, BlobSpot, FField.FieldNo);
   if BlobSpot>0 then begin
      Dec(BlobSpot);
      FDataSet.FBlobList.Items[BlobSpot].Modified:=True;
   end;
   FDataSet.DXTabGetActiveBuffer(DestBuffer);
   if Size>0 then Null:=False
   else Null:=True;
   FastMove(Null,(DestBuffer+FDataSet.DXTabGetFieldOffset(FField.FieldNo) + FDataSet.DXTabGetFieldSize(FField.FieldNo))^,DXBoolSize);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -