Показать сообщение отдельно
  #5  
Старый 23.08.2022, 01:09
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Для примера, вот моделька из одного из моих проектов. Она простая, там всего 2 уровня - сама модель и ее итемы.
Код:
unit Model;

interface

uses
  Classes, SysUtils, Contnrs, DateUtils, Generics.Collections, Forms, ActiveX, ModelBase,
  System.Variants, Dialogs;

const
  sigFileMark : String = 'bhpvMonitor';
  sigFileVersion : Integer = 1;

type
  TMonitorItem = class(TModelItemBase)
  private
    FGroupName : String;

    FGUID : TGUID;
    FUrl : String;
    FItemName : String;
	  FComments : String;

    FInitPrice : Currency;
    FInitDate : TDateTime;

    FWantedPrice : Currency;

    FLastPrice : Currency;
    FLastDate : TDateTime;

    FOnHold : Boolean;
    FFlagged : Boolean;
  protected
    procedure CreateInitFields;

  public
    constructor Create(AUrl : String);
    constructor Load(AStream : TStream; ADataVer : Integer);

	  procedure Assign(AItem : TMonitorItem);

    procedure SaveToStream(AStream : TStream); override;
    procedure LoadFromStream(AStream : TStream); override;
    procedure LoadFromStreamVer(AStream : TStream; ADataVer : Integer); virtual;

    procedure UpdateData;

    property GUID : TGUID read FGUID;
    property Url : String read FUrl;

    property ItemName : String read FItemName write FItemName;

    property InitPrice : Currency read FInitPrice;
    property InitDate : TDateTime read FInitDate;

    property WantedPrice : Currency read FWantedPrice write FWantedPrice;

    property LastPrice : Currency read FLastPrice;
    property LastDate : TDateTime read FLastDate;
  end;

  TMonitorModel = class(TModelBase)
  private
    FItems : TObjectList<TMonitorItem>;

    function GetCount : Integer;
    function GetItem(Index : Integer) : TMonitorItem;
  protected
    procedure SaveToStream(AStream : TStream); override;
    procedure LoadFromStream(AStream : TStream); override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure GetGroupsList(var AList : TStringList); overload;
    function GetGroupsList : TStringList; overload;

    procedure Clear;
    procedure AddItem(AItem : TMonitorItem);
    procedure DeleteItem(Index : Integer);
    procedure RemoveItem(AItem : TMonitorItem);
    function IndexOf(AItem : TMonitorItem) : Integer;
    function IndexOfByUrl(AUrl : String) : Integer;

    class function GetModelFileName : String;

    property Items[Index : Integer] : TMonitorItem read GetItem;
    property Count : Integer read GetCount;
  end;

implementation

uses
  IdHTTP, IdSSLOpenSSL, MSHTML, SysFolders;

{ TMonitorItem }

procedure TMonitorItem.CreateInitFields;
begin
  FGroupName := 'No group';
  
  CoCreateGUID(FGUID);
  FUrl := '';
  FItemName := '';
  FComments := '';

  FInitPrice := 0.0;
  FInitDate := 0;

  FWantedPrice := 0.0;

  FLastPrice := 0.0;
  FLastDate := 0;

  FOnHold := False;
  FFlagged := False;
end;

procedure TMonitorItem.Assign(AItem : TMonitorItem);
begin
  If Not Assigned(AItem)
    Then Raise Exception.Create('TMonitorItem.Assign: AItem parameter is not assigned.');

  Self.FGroupName := AItem.FGroupName;
  
  Self.FGUID := AItem.FGUID;
  Self.FUrl := AItem.FUrl;
  Self.FItemName := AItem.FItemName;
  Self.FComments := AItem.FComments;
  
  Self.FInitPrice := AItem.FInitPrice;
  Self.FInitDate := AItem.FInitDate;

  Self.FWantedPrice := AItem.FWantedPrice;

  Self.FLastPrice := AItem.FLastPrice;
  Self.FLastDate := AItem.FLastDate;

  Self.FOnHold := AItem.FOnHold;
  Self.FFlagged := AItem.FFlagged;
end;

procedure TMonitorItem.UpdateData;
var
  APage : String;
begin
//  APage := ReadInternetPage(FUrl);
//  SetValuesFromInternetPage(APage,False);
end;

constructor TMonitorItem.Create(AUrl : String);
var
  APage : String;
begin
  inherited Create;
  CreateInitFields;

  FUrl := AUrl;

  APage := ReadInternetPage(FUrl);
  SetValuesFromInternetPage(APage,True);
end;

constructor TMonitorItem.Load(AStream : TStream; ADataVer : Integer);
begin
  inherited Create;
  LoadFromStreamVer(AStream,ADataVer);
end;

procedure TMonitorItem.SaveToStream(AStream : TStream);
begin
  WriteString(AStream,FGroupName);
  
  WriteGUID(AStream,FGUID);
  WriteString(AStream,FUrl);
  WriteString(AStream,FItemName);
  WriteString(AStream,FComments);
  
  WriteCurrency(AStream,FInitPrice);
  WriteDateTime(AStream,FInitDate);

  WriteCurrency(AStream,FWantedPrice);

  WriteCurrency(AStream,FLastPrice);
  WriteDateTime(AStream,FLastDate);

  WriteBool(AStream,FOnHold);
  WriteBool(AStream,FFlagged);
end;

procedure TMonitorItem.LoadFromStream(AStream : TStream);
begin
  LoadFromStreamVer(AStream,-1);
end;

procedure TMonitorItem.LoadFromStreamVer(AStream : TStream; ADataVer : Integer);
begin
  If ADataVer = -1 Then ADataVer := sigFileVersion;

  FGroupName := ReadString(AStream);
  
  FGUID := ReadGUID(AStream);
  FUrl := ReadString(AStream);
  FItemName := ReadString(AStream);
  FComments := ReadString(AStream);

  FInitPrice := ReadCurrency(AStream);
  FInitDate := ReadDateTime(AStream);

  FWantedPrice := ReadCurrency(AStream);

  FLastPrice := ReadCurrency(AStream);
  FLastDate := ReadDateTime(AStream);

  FOnHold := ReadBool(AStream);
  FFlagged := ReadBool(AStream);

  If ADataVer > 1 Then // Version 2 and hier
    Begin

    End;
end;

{ TMonitorModel }

function TMonitorModel.GetCount : Integer;
begin
  Result := FItems.Count;
end;

function TMonitorModel.GetItem(Index : Integer) : TMonitorItem;
begin
  If (Index < 0) Or (Index > FItems.Count) Then
    Raise Exception.CreateFmt('GetItem. Index out of bounds (%d).',[Index]);
  Result := FItems[Index];
end;

constructor TMonitorModel.Create;
begin
  inherited;
  FItems := TObjectList<TMonitorItem>.Create(True);
end;

destructor TMonitorModel.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

procedure TMonitorModel.SaveToStream(AStream : TStream);
var
  I, ACnt : Integer;
begin
  AStream.WriteBuffer(sigFileMark[1],Length(sigFileMark)*SizeOf(Char));
  AStream.WriteBuffer(sigFileVersion,SizeOf(Integer));

  ACnt := FItems.Count;
  AStream.WriteBuffer(ACnt,SizeOf(Integer));
  For I := 0 To ACnt-1 Do
    Items[i].SaveToStream(AStream);
end;

procedure TMonitorModel.LoadFromStream(AStream : TStream);
var
  I, ACnt : Integer;
  AItem : TMonitorItem;
  rdMark : String;
  rdVersion : Integer;
begin
  FItems.Clear;

  SetLength(rdMark,Length(sigFileMark));
  AStream.ReadBuffer(rdMark[1],Length(sigFileMark)*SizeOf(Char));
  AStream.ReadBuffer(rdVersion,SizeOf(Integer));

  If rdMark <> sigFileMark Then
    Raise Exception.CreateFmt('Incorrect file signature (expected "%s", but got "%s").',[sigFileMark,rdMark]);
  If rdVersion > sigFileVersion Then
    Raise Exception.Createfmt('Wrong file version (expected less or equal %d, but found %d).',[sigFileVersion,rdVersion]);

  AStream.ReadBuffer(ACnt,SizeOf(Integer));
  For I := 0 To ACnt-1 Do
    Begin
      AItem := TMonitorItem.Load(AStream,rdVersion);
      FItems.Add(AItem);
    End;
end;

procedure TMonitorModel.GetGroupsList(var AList : TStringList);
var
  I, J : Integer;
  IsFound : Boolean;
begin
  If Not Assigned(AList)
    Then Raise Exception.Create('TMonitorModel.GetGroupsList: AList parameter is not assigned.');
	
  AList.Clear;
  For I := 0 To FItems.Count-1 Do
    Begin
	  IsFound := False;
	  For J := 0 To AList.Count-1 Do
	    Begin
		  IsFound := AnsiCompareText((FItems[i] As TMonitorItem).FGroupName,AList[J]) = 0;
		  If IsFound Then Break;
		End;
	  If Not IsFound 
	    Then AList.Add((FItems[i] As TMonitorItem).FGroupName);
    End;
end;

function TMonitorModel.GetGroupsList : TStringList;
begin
  Result := TStringList.Create;
  GetGroupsList(Result);
end;

procedure TMonitorModel.Clear;
begin
  FItems.Clear;
end;

procedure TMonitorModel.AddItem(AItem : TMonitorItem);
begin
  FItems.Add(AItem);
end;

procedure TMonitorModel.DeleteItem(Index : Integer);
begin
  FItems.Delete(Index);
end;

procedure TMonitorModel.RemoveItem(AItem : TMonitorItem);
begin
  FItems.Remove(AItem);
end;

function TMonitorModel.IndexOf(AItem : TMonitorItem) : Integer;
begin
  Result := FItems.IndexOf(AItem);
end;

function TMonitorModel.IndexOfByUrl(AUrl : String) : Integer;
var
  I : Integer;
begin
  Result := -1;
  For I := 0 To FItems.Count-1 Do
    If (FItems[i] As TMonitorItem).Url = AUrl Then
      Begin
        Result := I;
        Break;
      End;
end;

class function TMonitorModel.GetModelFileName : String;
var
  APath : String;
begin
  Try
    APath := GetUserAppDataFolderPath;
    APath := IncludeTrailingPathDelimiter(APath + 'bhpvMonitor');
    If Not DirectoryExists(APath) Then
      If Not ForceDirectories(APath) Then
        Raise Exception.Create('Can''t force user profile path.');
  Except
    APath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
  End;
  Result := APath + 'items.dat';
end;

end.

PS. Пришлось удалить пару методов, что бы влезть в ограничение длинны сообщения...
Ответить с цитированием