preximclasses.pas

一个很好的学习例子,有需要的请下载研究,

      AFileStream := TFileStream.Create(FStoredPath+FFilename, fmCreate or fmShareDenyWrite);
      try
        // read file size and allocate memory for storing data
        ASize := Reader.ReadInt64;
        while ASize > 0 do
        begin
          if ASize<=Sizeof(Buf) then
          begin
            Reader.Read(Buf, ASize);
            AFileStream.Write(Buf, ASize);
          end
          else begin
            Reader.Read(Buf, Sizeof(Buf));
            AFileStream.Write(Buf, Sizeof(Buf));
          end;

          Dec(ASize, Sizeof(Buf));
          
          //ProcessWindowsMessageQueue;
        end;
      finally
        FreeAndNil(AFileStream);
      end;

{      if NeedCompare then
        if CompareFiles(OldFileName, FStoredPath+FFilename) then
        begin
          SysUtils.DeleteFile(FStoredPath+FFilename);
          FileName := OldFileName;
        end;        }
    end;
//  ResetOperateStatus;
  end;
  inherited;
end;

{-------------------------------------------------------------------------------
  ProceName:  TPage.SaveToStream
  Purpose:    Write file data to a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
procedure TPage.SaveToStream(Stream: TStream);
var
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, $FF);
  try
    WriteData(Writer);
  finally
    FreeAndNil(Writer);
  end;
end;

procedure TPage.SetCaption(const Value: string);
begin
  if FCaption<>Value then
  begin
    FCaption := Value;
    ChangeOperateStatus;
  end;
end;

procedure TPage.SetFilename(const Value: TFilename);
begin
  FFilename := ExtractFileName(Value);
  FStoredPath := IncludeTrailingPathDelimiter(ExtractFilePath(Value));
  ChangeOperateStatus;
end;

procedure TPage.SetParent(const Value: TDocument);
begin
  if (FParent <> Value) and (Value is TDocument) then
    FParent := Value;
end;

procedure TPage.SetStoredPath(const Value: string);
begin
  FStoredPath := IncludeTrailingPathDelimiter(Value);
  ChangeOperateStatus;
end;

{-------------------------------------------------------------------------------
  ProceName:  TPage.WriteData
  Purpose:    Write page's filename to a stream
  Author:     Licwing
  Date:       08-15-2003
-------------------------------------------------------------------------------}
procedure TPage.WriteData(Writer: TWriter);
var
  //AFileStream: TFileMappingStream;
  AFileStream: TFileStream;
  Buf: array[0..511] of byte;
  ReadCount: integer;
begin
  // write TPage's signature
  Writer.WriteSignature;
//  inherited;

  // We don't need to save path to stream, because of the stream may be transferred
  // to another PC.
  with Writer do
  begin
    WriteString(FFilename);
    WriteString(FCaption);
    WriteBoolean(FKeepPageInStream);

    // We need to store page into stream if FKeepPageInStream is true
    if FKeepPageInStream then
    begin
      //AFileStream := TFileMappingStream.Create(FStoredPath+FFilename, fmOpenRead or fmShareDenyWrite);
      AFileStream := TFileStream.Create(FStoredPath+FFilename, fmOpenRead);
      try
        // Store file size
        Writer.WriteInteger(AFileStream.Size);
        // Store file data
        ReadCount := AFileStream.Read(Buf, Sizeof(Buf));
        while ReadCount > 0 do
        begin
          Writer.Write(Buf, ReadCount);
          ReadCount := AFileStream.Read(Buf, Sizeof(Buf));

          //ProcessWindowsMessageQueue;
        end;
      finally
        FreeAndNil(AFileStream);
      end;
    end;
  end;
  inherited;
end;

{ TFolderList }

function TFolderList.Add(AFolder: TFolder): Integer;
begin
  Result := inherited Add(AFolder);
end;

function TFolderList.Extract(Item: TFolder): TFolder;
begin
  Result := TFolder(inherited Extract(Item));
end;

function TFolderList.First: TFolder;
begin
  Result := TFolder(inherited First);
end;

function TFolderList.GetItem(Index: Integer): TFolder;
begin
  Result := TFolder(inherited Items[Index]);
end;

function TFolderList.IndexOf(AFolder: TFolder): Integer;
begin
  Result := inherited IndexOf(AFolder);
end;

procedure TFolderList.Insert(Index: Integer; AFolder: TFolder);
begin
  inherited Insert(Index, AFolder);
end;

function TFolderList.Last: TFolder;
begin
  Result := TFolder(inherited Last);
end;

function TFolderList.New: TFolder;
begin
  Result := TFolder.Create;
  Result.PageStoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

procedure TFolderList.ReadData(Reader: TReader);
var
  AFolder: TFolder;
  cName: string;
  FldsCount: integer;
begin
  // read TFolder signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    FldsCount := ReadInteger;
    //loop through file list of objects
    while FldsCount > 0 do
    begin
      //Load ClassName and use it to get ClassType
      cName := ReadString;

      // If a ClassType was found create an instance and
      // add object to this list
      if cName = TFolder.ClassName  then
      begin
        AFolder := New;
        AFolder.ReadData(Reader);
      end;
      Dec(FldsCount);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TFolderList.Remove(AFolder: TFolder): Integer;
begin
  Result := inherited Remove(AFolder);
end;

procedure TFolderList.SetItem(Index: Integer; const Value: TFolder);
begin
  inherited Items[Index] := Value;
end;


procedure TFolderList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TFolderList signature;
  Writer.WriteSignature;
  inherited;

  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteInteger(Count);

    for Idx := 0 to Count - 1 do
    begin
      //Store any TDocument objects
      if TObject(Items[Idx]) is TFolder then
      begin
        WriteString(TFolder(Items[Idx]).ClassName);
        //Call WriteData() for TFolder objects}
        TFolder(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;


{ TStreamObjectList }

constructor TStreamObjectList.Create;
begin
  inherited Create;
  fKeepPageInStream := true;
end;

procedure TStreamObjectList.LoadFromStream(Stream: TStream);
var
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, $FF);
  try
    ReadData(Reader);
  finally
    FreeAndNil(Reader);
  end;
end;

function TStreamObjectList.Modified: boolean;
var
  Idx: integer;
begin
  Result := false;
  for Idx:=0 to Count-1 do
  begin
    Result := TCustomStorageObject(Items[Idx]).Modified;
    
    if Result then break;
  end;
end;

procedure TStreamObjectList.ResetOperateStatus;
var
  Idx: integer;
begin
  for Idx:=0 to Count-1 do
  begin
    TCustomStorageObject(Items[Idx]).ResetOperateStatus;

    //ProcessWindowsMessageQueue;
  end;
end;

procedure TStreamObjectList.SaveToStream(Stream: TStream);
var
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, $FF);
  try
    WriteData(Writer);
  finally
    FreeAndNil(Writer);
  end;
end;

procedure TStreamObjectList.SetKeepPageInStream(const Value: boolean);
var
  Idx: integer;
  AObject: TObject;
begin
  if fKeepPageInStream <> Value then
  begin
    fKeepPageInStream := Value;
    for Idx:=0 to Count-1 do
    begin
      AObject := Items[Idx];
      if AObject is TCustomStorageObject then
        with TCustomStorageObject(AObject) do
          if (OperateStatus<>opMove) or (OperateStatus<>opMoveFax) or
             (OperateStatus<> opInsert) then KeepPageInStream := Value;

       //ProcessWindowsMessageQueue;
    end;
  end;
end;
{ TPageList }

function TPageList.Add(APage: TPage): Integer;
begin
  Result := inherited Add(APage);
end;

function TPageList.Extract(Item: TPage): TPage;
begin
  Result := TPage(inherited Extract(Item));
end;

function TPageList.First: TPage;
begin
  Result := TPage(inherited First);
end;

function TPageList.GetItem(Index: Integer): TPage;
begin
  Result := TPage(inherited Items[Index]);
end;

function TPageList.IndexOf(APage: TPage): Integer;
begin
  Result := inherited IndexOf(APage);
end;

procedure TPageList.Insert(Index: Integer; APage: TPage);
begin
  inherited Insert(Index, APage);
end;

function TPageList.Last: TPage;
begin
  Result := TPage(inherited Last);
end;

function TPageList.New: TPage;
begin
  Result := TPage.Create;
  Result.StoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

procedure TPageList.ReadData(Reader: TReader);
var
  APage: TPage;
  cName: string;
  PagesCount: integer;
begin
  // read TPageList signature
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    PagesCount := ReadInteger;
    //loop through file list of objects
    while PagesCount > 0 do
    begin
      //Load ClassName and use it to get ClassType
      cName := ReadString;

      // If a ClassType was found create an instance and
      // add object to this list
      if cName = TPage.ClassName  then
      begin
        APage := New;
        APage.PageStoredPath := fPageStoredPath;
        APage.ReadData(Reader);
      end;
      Dec(PagesCount);

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

function TPageList.Remove(APage: TPage): Integer;
begin
  Result := inherited Remove(APage);
end;

procedure TPageList.SetItem(Index: Integer; const Value: TPage);
begin
  inherited Items[Index] := Value;
end;

procedure TPageList.WriteData(Writer: TWriter);
var
  Idx: integer;
begin
  // write TPageList signature;
  Writer.WriteSignature;
  inherited;

  with Writer do
  begin
    // mark beginning of file and beginning of object list
    WriteInteger(Count);

    for Idx := 0 to Count - 1 do
    begin
      //Store any TDocument objects
      if TObject(Items[Idx]) is TPage then
      begin
        WriteString(TPage(Items[Idx]).ClassName);
        //Call WriteData() for TFolder objects}
        TPage(Items[Idx]).WriteData(Writer);
      end;

      //ProcessWindowsMessageQueue;
    end;
  end;
end;

{ TTransactionList }

function TTransactionList.Add(ATransaction: TTransaction): Integer;
begin
  Result := inherited Add(ATransaction);
end;

function TTransactionList.Extract(Item: TTransaction): TTransaction;
begin
  Result := TTransaction(inherited Extract(Item));
end;

function TTransactionList.First: TTransaction;
begin
  Result := TTransaction(inherited First);
end;

function TTransactionList.GetItem(Index: Integer): TTransaction;
begin
  Result := TTransaction(inherited Items[Index]);
end;

function TTransactionList.IndexOf(ATransaction: TTransaction): Integer;
begin
  Result := inherited IndexOf(ATransaction);
end;

procedure TTransactionList.Insert(Index: Integer; ATransaction: TTransaction);
begin
   inherited Insert(Index, ATransaction);
end;

function TTransactionList.Last: TTransaction;
begin
  Result := TTransaction(inherited Last);
end;

function TTransactionList.New: TTransaction;
begin
  Result := TTransaction.Create;
  Result.PageStoredPath := PageStoredPath;
  Result.OperateStatus := opInsert;
  Add(Result);
end;

procedure TTransactionList.ReadData(Reader: TReader);
var
  ATxn: TTransaction;
  cName: string;
  TxnsCount: integer;
begin
  Reader.ReadSignature;
  inherited;

  // clear all old items
  Clear;

  with Reader do
  begin
    // read beginning of file and beginning of object list markers
    TxnsCount := ReadInteger;
    //loop through file list of objects
    while TxnsCount > 0 do