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

📄 addrbk.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 2 页
字号:

function TEmails.FindItem(Value: TEmail): Integer;
var i: Integer;
begin
  Result := -1;

  for i := 0 to Count - 1 do begin
    if Emails[i] = Value then begin
      Result := i;
      break;
    end;
  end;
end;

{ TPersons }

function TPersons.Add: TPerson;
begin
  Result := (inherited Add) as TPerson;

  Inc(FLastID);
  Result.id := FLastID;
end;

function TPersons.FindItemID(ID: Integer): TPerson;
begin
  Result := (inherited FindItemID(ID)) as TPerson;
end;

function TPersons.Insert(Index: Integer): TPerson;
begin
  Result := (inherited Insert(Index)) as TPerson;
end;

function TPersons.GetPerson(Index: Integer): TPerson;
begin
  Result := (inherited GetItem(Index)) as TPerson;
end;

procedure TPersons.SetPerson(Index: Integer; const Value: TPerson);
begin
  inherited SetItem(Index, Value);
end;

function TPersons.FindItem(Value: TPerson): Integer;
var i: Integer;
begin
  Result := -1;

  for i := 0 to Count - 1 do begin
    if Persons[i] = Value then begin
      Result := i;
      break;
    end;
  end;
end;

{ TAddressBooks }

function TAddressBooks.Add(addrBkName: String): TAddressBook;
begin
  Result := (inherited Add) as TAddressBook;
  Result.BookName := addrBkName;
end;

function TAddressBooks.FindItemID(ID: Integer): TAddressBook;
begin
  Result := (inherited FindItemID(ID)) as TAddressBook;
end;

function TAddressBooks.Insert(Index: Integer): TAddressBook;
begin
  Result := (inherited Insert(Index)) as TAddressBook;
end;

function TAddressBooks.GetAddressBook(Index: Integer): TAddressBook;
begin
  Result := (inherited GetItem(Index)) as TAddressBook;
end;

procedure TAddressBooks.SetAddressBook(Index: Integer; const Value: TAddressBook);
begin
  inherited SetItem(Index, Value);
end;

constructor TAddressBooks.Create(fileName: String);
begin
  inherited Create(TAddressBook);

  FFileName := fileName;

  if not DirectoryExists(ExtractFilePath(FFileName) +'Pictures\') then
    ForceDirectories(ExtractFilePath(FFileName) +'Pictures\');
  if not DirectoryExists(ExtractFilePath(FFileName) +'Certificates\') then
    ForceDirectories(ExtractFilePath(FFileName) +'Certificates\');

  FPicturesPath := ExtractFilePath(FFileName) +'Pictures\';
  FCertificatesPath := ExtractFilePath(FFileName) +'Certificates\';
end;

procedure TAddressBooks.Load;
begin
  if FileExists(FFileName) then
    TOmniMyXMLReader.LoadFromFile(Self, FFileName);
end;

procedure TAddressBooks.Save;
begin
  if FDirty then begin
    TOmniMyXMLWriter.SaveToFile(Self, FFileName, ofIndent);
    FDirty := False;
  end;
end;

//function returns 0 if no number is needed for book name to be unique
//or number so new address book name is unique
function TAddressBooks.GetNoForName(bookName: String): Integer;
  function IsUnique(st: String): Boolean;
  var c, i: Integer;
  begin
    c := Count - 1;
    Result := True;
    for i := 0 to c do begin
      if st = AddressBooks[i].BookName then begin
        Result := False;
        break;
      end;
    end;
  end;

var tmpStr: String;
begin
  Result := 0;

  tmpStr := bookName;
  while not IsUnique(tmpStr) do begin
    Result := GetTickCount;
    if Result = 0 then Inc(Result); //result cannot be 0
    tmpStr := bookName + '-' + IntToHex(Result, 4);
  end;

end;

function TAddressBooks.FindItem(Value: TAddressBook): Integer;
var i: Integer;
begin
  Result := -1;

  for i := 0 to Count - 1 do begin
    if AddressBooks[i] = Value then begin
      Result := i;
      break;
    end;
  end;
end;

{ TPersonal }

procedure TPersonal.Assign(Source: TPersistent);
var b: TPersonal;
begin
  b := Source as TPersonal;
  Self.Birthday := b.Birthday;
  Self.Anniversary := b.Anniversary;
  Self.CustomField1 := b.CustomField1;
  Self.CustomField2 := b.CustomField2;
  Self.CustomField3 := b.CustomField3;
  Self.CustomField4 := b.CustomField4;
  Self.CustomFieldLabel1 := b.CustomFieldLabel1;
  Self.CustomFieldLabel2 := b.CustomFieldLabel2;
  Self.CustomFieldLabel3 := b.CustomFieldLabel3;
  Self.CustomFieldLabel4 := b.CustomFieldLabel4;
  Self.Chats.Assign(b.Chats);
end;

constructor TPersonal.Create;
begin
  inherited Create;

  FChats := TChats.Create(TChat);
end;

destructor TPersonal.Destroy;
begin
  FreeAndNil(FChats);

  inherited Destroy;
end;

{ TPerson }

procedure TPerson.Assign(Source: TPersistent);
var b: TPerson;
begin
  b := Source as TPerson;
  Self.General.Assign(b.General);
  Self.Home.Assign(b.Home);
  Self.Personal.Assign(b.Personal);
  Self.Work.Assign(b.Work);
  Self.Emails.Assign(b.Emails);
  Self.Notes := b.Notes;
end;

constructor TPerson.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  FGeneral := TGeneral.Create;
  FHome := THome.Create;
  FPersonal := TPersonal.Create;
  FWork := TWork.Create;
  FEmails := TEmails.Create(TEmail);
end;

procedure TPerson.Delete;
var id: Integer;
begin
  id := (Collection as TPersons).FindItem(Self);
  if id >= 0 then
    Collection.Delete(id);
end;

destructor TPerson.Destroy;
begin
  FreeAndNil(FGeneral);
  FreeAndNil(FHome);
  FreeAndNil(FPersonal);
  FreeAndNil(FWork);
  FreeAndNil(FEmails);

  inherited Destroy;
end;

{ TAddressBook }

constructor TAddressBook.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FPersons := TPersons.Create(TPerson);
end;

procedure TAddressBook.Delete;
var id: Integer;
begin
  id := (Collection as TAddressBooks).FindItem(Self);
  if id >= 0 then
    Collection.Delete(id);
end;

destructor TAddressBook.Destroy;
begin
  FreeAndNil(FPersons);

  inherited Destroy;
end;

{ TGeneral }

procedure TGeneral.Assign(Source: TPersistent);
var b: TGeneral;
begin
  b := Source as TGeneral;
  Self.FirstName := b.FirstName;
  Self.MiddleName := b.MiddleName;
  Self.LastName := b.LastName;
  Self.NickName := b.NickName;
  Self.Gender := b.Gender;
  Self.PhotoName := b.PhotoName;
end;

{ THome }

procedure THome.Assign(Source: TPersistent);
var b: THome;
begin
  b := Source as THome;
  Self.Telephone := b.Telephone;
  Self.Extension := b.Extension;
  Self.Mobile := b.Mobile;
  Self.Fax := b.Fax;
  Self.Pager := b.Pager;
  Self.Street := b.Street;
  Self.ZIP := b.ZIP;
  Self.State := b.State;
  Self.Country := b.Country;
  Self.Homepage := b.Homepage;
end;

{ TWork }

procedure TWork.Assign(Source: TPersistent);
var b: TWork;
begin
  inherited Assign(Source);
  b := Source as TWork;
  Self.CompanyName := b.CompanyName;
  Self.JobTitle := b.JobTitle;
  Self.Department := b.Department;
end;

{ TEmail }

procedure TEmail.Assign(Source: TPersistent);
var b: TEmail;
begin
  b := Source as TEmail;
  Self.Email := b.Email;
end;

{ TChat }

procedure TChat.Assign(Source: TPersistent);
var b: TChat;
begin
  b := Source as TChat;
  Self.Application := b.Application;
  Self.ID := b.ID;
end;

end.

⌨️ 快捷键说明

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