You've already forked lazarus-ccr
tvplanit: Export contacts as vcard files. Fix some bugs in vcard import.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8395 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -162,11 +162,13 @@ resourcestring
|
||||
|
||||
{Contact Specific}
|
||||
RSContactPopupAdd = 'Add contact...';
|
||||
RSContactPopupAddVCards = 'Add contact from vCard(s)...';
|
||||
RSContactPopupEdit = 'Edit contact...';
|
||||
RSContactPopupDelete = 'Delete contact...';
|
||||
RSConfirmDeleteContact = 'Delete contact %s?';
|
||||
RSContactPopupImportVCards= 'Import contact(s) from vCard(s)...';
|
||||
RSContactPopupExportVCard = 'Export contact to vCard...';
|
||||
RSLoadVCardsTitle = 'Import from vCard(s)';
|
||||
RSSaveVCardTitle = 'Export to vCard';
|
||||
RSVCardFilter = 'vCard files (*.vcf)|*.vcf';
|
||||
RSContactItems = 'Contact items';
|
||||
|
||||
|
||||
@ -81,7 +81,8 @@ type
|
||||
mikAddEvent, mikEditEvent, mikDeleteEvent,
|
||||
mikAddTask, mikEditTask, mikDeleteTask,
|
||||
mikAddContact, mikEditContact, mikDeleteContact,
|
||||
mikImportEventFromICal, mikImportTaskFromICal, mikImportContactFromVCards,
|
||||
mikImportEventFromICal, mikImportTaskFromICal,
|
||||
mikImportContactFromVCards, mikExportContactToVCard,
|
||||
mikResourceGroups, mikNoOverlaidEvents,
|
||||
mikChangeDate, mikCustomDate, mikToday, mikYesterday, mikTomorrow,
|
||||
mikPrevDay, mikNextDay, mikPrevWeek, mikNextWeek,
|
||||
@ -93,7 +94,8 @@ type
|
||||
RSPopupAddEvent, RSPopupEditEvent, RSPopupDeleteEvent,
|
||||
RSTaskPopupAdd, RSTaskPopupEdit, RSTaskPopupDelete,
|
||||
RSContactPopupAdd, RSContactPopupEdit, RSContactPopupDelete,
|
||||
RSPopupAddEventFromICal, RSPopupAddTaskFromICal, RSContactPopupAddVCards,
|
||||
RSPopupAddEventFromICal, RSPopupAddTaskFromICal,
|
||||
RSContactPopupImportVCards, RSContactPopupExportVCard,
|
||||
RSPopupResourceGroups, RSNoOverlayedEvents,
|
||||
RSPopupChangeDate, RSCustomDate, RSToday, RSYesterday, RSTomorrow,
|
||||
RSPrevDay, RSNextDay, RSPrevWeek, RSNextWeek,
|
||||
|
||||
@ -94,8 +94,9 @@ procedure TVpFileItem.GetParts(AText: String; out AKey: String;
|
||||
var
|
||||
p: Integer;
|
||||
keypart, valuepart: String;
|
||||
i: Integer;
|
||||
i, j, n: Integer;
|
||||
QuotedPrintable: Boolean = false;
|
||||
sa: TStringArray = nil;
|
||||
begin
|
||||
// Split at ':' into key and value parts
|
||||
p := pos(KEY_VALUE_DELIMITER, AText);
|
||||
@ -106,6 +107,25 @@ begin
|
||||
|
||||
// Process key part
|
||||
Attr := nil;
|
||||
(*
|
||||
sa := keypart.Split(KEY_DELIMITER);
|
||||
AKey := sa[0];
|
||||
for i := 1 to High(sa) do
|
||||
// We only consider the "type" attributes...
|
||||
if pos('TYPE=', Uppercase(sa[i])) = 1 then
|
||||
begin
|
||||
keypart := copy(keypart, Length('TYPE='), MaxInt);
|
||||
Attr := keypart.Split(TYPE_DELIMITER); // Split at ','
|
||||
end else
|
||||
Attr := keypart.Split(KEY_DELIMITER); // Split at ';'
|
||||
|
||||
for i := Low(Attr) to High(Attr) do
|
||||
if Attr[i] = 'QUOTED-PRINTABLE' then
|
||||
begin
|
||||
QuotedPrintable := true;
|
||||
break;
|
||||
end;
|
||||
*)
|
||||
p := pos(KEY_DELIMITER, keypart);
|
||||
if p = 0 then begin
|
||||
AKey := keypart;
|
||||
@ -114,10 +134,21 @@ begin
|
||||
AKey := Copy(keypart, 1, p-1);
|
||||
keypart := Copy(keypart, p+1, MaxInt);
|
||||
if pos('TYPE=', keypart) = 1 then begin
|
||||
keypart := copy(keypart, Length('TYPE='), MaxInt);
|
||||
Attr := Split(keypart, TYPE_DELIMITER); // Split at ','
|
||||
keypart := copy(keypart, Length('TYPE=')+1, MaxInt);
|
||||
sa := Split(keypart, TYPE_DELIMITER); // Split at ','
|
||||
n := Length(Attr);
|
||||
SetLength(Attr, n + Length(sa));
|
||||
for j := 0 to High(sa) do
|
||||
Attr[n+j] := sa[j];
|
||||
end else
|
||||
Attr := Split(keypart, KEY_DELIMITER); // Split at ';'
|
||||
begin
|
||||
sa := Split(keypart, KEY_DELIMITER); // Split at ';'
|
||||
n := Length(Attr);
|
||||
SetLength(Attr, n + Length(sa));
|
||||
for j := 0 to High(sa) do
|
||||
Attr[n+j] := sa[j];
|
||||
end;
|
||||
|
||||
for i:=Low(Attr) to High(Attr) do
|
||||
if Attr[i] = 'QUOTED-PRINTABLE' then begin
|
||||
QuotedPrintable := true;
|
||||
|
||||
@ -201,9 +201,10 @@ type
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure ScrollIntoView;
|
||||
procedure PopupAddContact(Sender: TObject);
|
||||
procedure PopupAddVCards(Sender: TObject);
|
||||
procedure PopupDeleteContact(Sender: TObject);
|
||||
procedure PopupEditContact(Sender: TObject);
|
||||
procedure PopupExportVCard(Sender: TObject);
|
||||
procedure PopupImportVCards(Sender: TObject);
|
||||
procedure EditContact;
|
||||
procedure EndEdit(Sender: TObject);
|
||||
function GetPopupMenu: TPopupMenu; override;
|
||||
@ -249,6 +250,7 @@ type
|
||||
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
|
||||
StartLine, StopLine: Integer; UseGran: TVpGranularity;
|
||||
DisplayOnly: Boolean); override;
|
||||
procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
|
||||
function ImportVCardFile(const AFileName: String;
|
||||
APreview: Boolean = false): TVpContactArr;
|
||||
|
||||
@ -1078,7 +1080,9 @@ begin
|
||||
end else
|
||||
if Button = mbRight then begin
|
||||
HideHintWindow;
|
||||
if not Assigned (PopupMenu) then begin
|
||||
//if not Assigned (PopupMenu) then begin
|
||||
if (PopupMenu = FDefaultPopup) then
|
||||
begin
|
||||
if not Focused then
|
||||
SetFocus;
|
||||
cgClickPoint := Point(X, Y);
|
||||
@ -1539,7 +1543,7 @@ begin
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikAddContact;
|
||||
NewItem.OnClick := PopupAddContact;
|
||||
NewItem.Tag := 0;
|
||||
NewItem.Tag := 0; // Tag = 1: disabled when readonly or no active contact.
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
|
||||
@ -1559,16 +1563,26 @@ begin
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
|
||||
if RsContactPopupAddVCards <> '' then begin
|
||||
if (RsContactPopupImportVCards <> '') or (RSContactPopupExportVCard <> '') then begin
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikSeparator;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikImportContactFromVCards;
|
||||
NewItem.OnClick := PopupAddVCards;
|
||||
NewItem.Tag := 0;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
if RsContactPopupImportVCards <> '' then begin
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikImportContactFromVCards;
|
||||
NewItem.OnClick := PopupImportVCards;
|
||||
NewItem.Tag := 0;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
|
||||
if RsContactPopupExportVCard <> '' then begin
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikExportContactToVCard;
|
||||
NewItem.OnClick := PopupExportVCard;
|
||||
NewItem.Tag := 1;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1591,6 +1605,15 @@ begin
|
||||
cgSpawnContactEditDialog(True);
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.ExportVCardFile(const AFileName: String;
|
||||
const AContacts: TVpContactArr);
|
||||
begin
|
||||
if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) then
|
||||
exit;
|
||||
|
||||
Datastore.Resource.Contacts.ExportVCardFile(AFileName, AContacts);
|
||||
end;
|
||||
|
||||
function TVpContactGrid.ImportVCardFile(const AFileName: String;
|
||||
APreview: Boolean = false): TVpContactArr;
|
||||
begin
|
||||
@ -1609,7 +1632,46 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupAddVCards(Sender: TObject);
|
||||
procedure TVpContactGrid.PopupDeleteContact (Sender : TObject);
|
||||
begin
|
||||
if ReadOnly then
|
||||
Exit;
|
||||
if FActiveContact <> nil then
|
||||
DeleteActiveContact (True);
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupEditContact (Sender : TObject);
|
||||
begin
|
||||
if ReadOnly then
|
||||
Exit;
|
||||
if FActiveContact <> nil then
|
||||
{ edit this contact }
|
||||
cgSpawnContactEditDialog(False);
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupExportVCard(Sender: TObject);
|
||||
var
|
||||
dlg: TSaveDialog;
|
||||
begin
|
||||
if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or
|
||||
(FActiveContact = nil)
|
||||
then
|
||||
exit;
|
||||
|
||||
dlg := TSaveDialog.Create(nil);
|
||||
try
|
||||
dlg.Title := RSSaveVCardTitle;
|
||||
dlg.Filter := RSVCardFilter;
|
||||
dlg.FileName := '';
|
||||
dlg.Options := dlg.Options - [ofAllowMultiSelect] + [ofOverwritePrompt];
|
||||
if dlg.Execute then
|
||||
ExportVCardFile(dlg.FileName, [FActiveContact]);
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupImportVCards(Sender: TObject);
|
||||
var
|
||||
dlg: TOpenDialog;
|
||||
vcards: TVpVCards;
|
||||
@ -1631,50 +1693,12 @@ begin
|
||||
if dlg.Execute then begin
|
||||
for fn in dlg.Files do
|
||||
ImportVCardFile(fn, dlg.Files.Count=1);
|
||||
(*
|
||||
Screen.Cursor := crHourGlass;
|
||||
Application.ProcessMessages;
|
||||
vcards := TVpVCards.Create;
|
||||
try
|
||||
for fn in dlg.Files do begin
|
||||
vcards.LoadFromFile(fn);
|
||||
for i := 0 to vcards.Count-1 do begin
|
||||
id := DataStore.GetNextID (ContactsTableName);
|
||||
FActiveContact := Datastore.Resource.Contacts.AddContact(id);
|
||||
FActiveContact.LoadFromVCard(vcards[i]);
|
||||
Datastore.PostContacts;
|
||||
DataStore.NotifyDependents;
|
||||
end;
|
||||
end;
|
||||
Invalidate;
|
||||
finally
|
||||
vcards.Free;
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupDeleteContact (Sender : TObject);
|
||||
begin
|
||||
if ReadOnly then
|
||||
Exit;
|
||||
if FActiveContact <> nil then
|
||||
DeleteActiveContact (True);
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.PopupEditContact (Sender : TObject);
|
||||
begin
|
||||
if ReadOnly then
|
||||
Exit;
|
||||
if FActiveContact <> nil then
|
||||
{ edit this contact }
|
||||
cgSpawnContactEditDialog(False);
|
||||
end;
|
||||
|
||||
procedure TVpContactGrid.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
PopupPoint: TPoint;
|
||||
|
||||
@ -495,6 +495,7 @@ type
|
||||
function GetContact(Index: Integer): TVpContact;
|
||||
function Last:TVpContact;
|
||||
function ImportVCardFile(const AFileName: String; const APreview: Boolean = false): TVpContactArr;
|
||||
procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
|
||||
procedure Sort;
|
||||
|
||||
property ContactsList: TList
|
||||
@ -626,6 +627,9 @@ type
|
||||
function ContainsWorkData: Boolean;
|
||||
function ContainsHomeData: Boolean;
|
||||
function FullName: string;
|
||||
|
||||
// VCards
|
||||
function CreateVCard: TVpVCard;
|
||||
procedure LoadFromVCard(ACard: TVpVCard);
|
||||
|
||||
property Loading: Boolean read FLoading write FLoading;
|
||||
@ -2117,6 +2121,100 @@ begin
|
||||
Result := (Address1 <> '') or (FCity1 <> '') or (FState1 <> '') or (FCountry1 <> '');
|
||||
end;
|
||||
|
||||
function TVpContact.CreateVCard: TVpVCard;
|
||||
|
||||
function FirstOrSecond(Which, KeyFirst, KeySecond: Integer; First, Second: String): String;
|
||||
begin
|
||||
if Which = KeyFirst then
|
||||
Result := First
|
||||
else if Which = KeySecond then
|
||||
Result := Second
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function GetAddressDetail(AddrType: TVpAddressType; What: String): String;
|
||||
var
|
||||
at: integer;
|
||||
begin
|
||||
at := ord(AddrType);
|
||||
case What of
|
||||
'Address':
|
||||
Result := FirstOrSecond(at, FAddressType1, FAddressType2, FAddress1, FAddress2);
|
||||
'City':
|
||||
Result := FirstOrSecond(at, FAddressType1, FAddressType2, FCity1, FCity2);
|
||||
'Zip':
|
||||
Result := FirstOrSecond(at, FAddressType1, FAddressType2, FZip1, FZip2);
|
||||
'State':
|
||||
Result := FirstOrSecond(at, FAddressType1, FAddressType2, FState1, FState2);
|
||||
'Country':
|
||||
Result := FirstOrSecond(at, FAddressType1, FAddressType2, FCountry1, FCountry2);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetEMail(AEMailType: TVpEMailType): String;
|
||||
begin
|
||||
if ord(AEMailType) = FEMailType1 then
|
||||
Result := FEMail1
|
||||
else if ord(AEMailType) = FEMailType2 then
|
||||
Result := FEMail2
|
||||
else if ord(AEMailType) = FEMailType3 then
|
||||
Result := FEMail3
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function GetPhone(APhoneType: TVpPhoneType): String;
|
||||
begin
|
||||
if ord(APhoneType) = FPhoneType1 then
|
||||
Result := FPhone1
|
||||
else if ord(APhoneType) = FPhoneType2 then
|
||||
Result := FPhone2
|
||||
else if ord(APhoneType) = FPhoneType3 then
|
||||
Result := FPhone3
|
||||
else if ord(APhoneType) = FPhoneType4 then
|
||||
Result := FPhone4
|
||||
else if ord(APhoneType) = FPhoneType5 then
|
||||
Result := FPhone5
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
Result := TVpVCard.Create;
|
||||
Result.LastName := FLastName;
|
||||
Result.FirstName := FFirstName;
|
||||
Result.Title := FTitle;
|
||||
|
||||
Result.Company := FCompany;
|
||||
Result.WorkAddress := GetAddressDetail(atWork, 'Address');
|
||||
Result.WorkCity := GetAddressDetail(atWork, 'City');
|
||||
Result.WorkZip := GetAddressDetail(atWork, 'Zip');
|
||||
Result.WorkState := GetAddressDetail(atWork, 'State');
|
||||
Result.WorkCountry := GetAddressDetail(atWork, 'Country');
|
||||
Result.WorkPhone := GetPhone(ptWork);
|
||||
Result.WorkFax := GetPhone(ptWorkFax);
|
||||
Result.WorkEMail := GetEMail(mtWork);
|
||||
|
||||
Result.WorkAddress := GetAddressDetail(atHome, 'Address');
|
||||
Result.WorkCity := GetAddressDetail(atHome, 'City');
|
||||
Result.WorkZip := GetAddressDetail(atHome, 'Zip');
|
||||
Result.WorkState := GetAddressDetail(atHome, 'State');
|
||||
Result.WorkCountry := GetAddressDetail(atHome, 'Country');
|
||||
Result.HomePhone := GetPhone(ptHome);
|
||||
Result.HomeFax := GetPhone(ptHomeFax);
|
||||
Result.HomeEMail := GetEMail(mtHome);
|
||||
|
||||
Result.CarPhone := GetPhone(ptCar);
|
||||
Result.Mobile := GetPhone(ptMobile);
|
||||
Result.ISDN := GetPhone(ptISDN);
|
||||
Result.Pager := GetPhone(ptPager);
|
||||
|
||||
Result.BirthDay := FBirthdate;
|
||||
Result.Anniversary := FAnniversary;
|
||||
end;
|
||||
|
||||
function TVpContact.FullName : string;
|
||||
begin
|
||||
if (FFirstName = '') and (FLastName = '') then
|
||||
@ -2790,6 +2888,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpContacts.ExportVCardFile(const AFileName: String;
|
||||
const AContacts: TVpContactArr);
|
||||
var
|
||||
vCards: TVpVCards;
|
||||
lContact: TVpContact;
|
||||
begin
|
||||
vCards := TVpVCards.Create;
|
||||
try
|
||||
for lContact in AContacts do
|
||||
if lContact <> nil then
|
||||
vCards.Add(lContact.CreateVCard);
|
||||
vCards.SaveToFile(AFileName);
|
||||
finally
|
||||
vCards.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TVpContacts.ImportVCardFile(const AFileName: String;
|
||||
const APreview: Boolean = false): TVpContactArr;
|
||||
const
|
||||
|
||||
@ -20,11 +20,11 @@ inherited VpImportPreviewVCardForm: TVpImportPreviewVCardForm
|
||||
PickList.Strings = ( )
|
||||
ReadOnly = True
|
||||
Title.Caption = 'Items'
|
||||
Width = 630
|
||||
Width = 634
|
||||
end>
|
||||
ColWidths = (
|
||||
33
|
||||
630
|
||||
634
|
||||
)
|
||||
end
|
||||
inherited ButtonPanel: TPanel
|
||||
|
||||
@ -79,15 +79,15 @@ begin
|
||||
|
||||
s := ACard.GetWorkAddress;
|
||||
if s <> '' then
|
||||
Result := Result + LineEnding + RSWorkAddress + ' ' + s;
|
||||
Result := Result + LineEnding + RSWorkAddress + ': ' + s;
|
||||
|
||||
s := ACard.GetHomeAddress;
|
||||
if s <> '' then
|
||||
Result := Result + LineEnding + RSHomeAddress + ' ' + s;
|
||||
Result := Result + LineEnding + RSHomeAddress + ': ' + s;
|
||||
|
||||
s := ACard.GetPhone;
|
||||
if s <> '' then
|
||||
Result := Result + LineEnding + RSPhone + ' ' + s;
|
||||
Result := Result + LineEnding + RSPhone + ': ' + s;
|
||||
|
||||
s := ACard.GetEMail;
|
||||
if s <> '' then
|
||||
|
||||
@ -205,7 +205,7 @@ implementation
|
||||
uses
|
||||
Math,
|
||||
{$IFDEF LCL}
|
||||
DateUtils, StrUtils, EditBtn, ButtonPanel,
|
||||
DateUtils, StrUtils, LazUTF8, EditBtn, ButtonPanel,
|
||||
{$ENDIF}
|
||||
VpSR, VpBaseDS;
|
||||
|
||||
@ -395,7 +395,7 @@ var
|
||||
begin
|
||||
{be sure that the Canvas Font is set before entering this routine}
|
||||
EllipsisWidth := Canvas.TextWidth(ELLIPSIS);
|
||||
Len := Length(S);
|
||||
Len := UTF8Length(S);
|
||||
Result := S;
|
||||
Extent := Canvas.TextWidth(Result);
|
||||
ShowEllipsis := False;
|
||||
@ -404,7 +404,7 @@ begin
|
||||
ShowEllipsis := True;
|
||||
Width := MaxWidth - EllipsisWidth;
|
||||
if Len > MinChars then begin
|
||||
Delete(Result, Len, 1);
|
||||
UTF8Delete(Result, Len, 1);
|
||||
dec(Len);
|
||||
end else
|
||||
break;
|
||||
@ -416,7 +416,7 @@ begin
|
||||
Extent := Canvas.TextWidth(Result);
|
||||
iDots := 3;
|
||||
while (iDots > 0) and (Extent > MaxWidth) do begin
|
||||
Delete(Result, Len, 1);
|
||||
UTF8Delete(Result, Len, 1);
|
||||
Dec(Len);
|
||||
Extent := Canvas.TextWidth(Result);
|
||||
Dec(iDots);
|
||||
|
||||
@ -47,6 +47,9 @@ type
|
||||
FCarPhone: String;
|
||||
FISDN: String;
|
||||
FPager: String;
|
||||
|
||||
FBirthDay: TDateTime;
|
||||
FAnniversary: TDateTime;
|
||||
|
||||
FSkip: Boolean;
|
||||
public
|
||||
@ -60,36 +63,41 @@ type
|
||||
function GetPhone: String;
|
||||
function GetWorkAddress: String;
|
||||
|
||||
property FirstName: String read FFirstName;
|
||||
property LastName: String read FLastName;
|
||||
property Title: String read FTitle;
|
||||
procedure SaveToStrings(AList: TStrings);
|
||||
|
||||
property Company: String read FCompany;
|
||||
property WorkAddress: String read FWorkAddress;
|
||||
property WorkCity: String read FWorkCity;
|
||||
property WorkZip: String read FWorkZip;
|
||||
property WorkState: String read FWorkState;
|
||||
property WorkCountry: String read FWorkCountry;
|
||||
property WorkEMail: String read FWorkEMail;
|
||||
property WorkPhone: String read FWorkPhone;
|
||||
property WorkFax: String read FWorkFax;
|
||||
property FirstName: String read FFirstName write FFirstName;
|
||||
property LastName: String read FLastName write FLastName;
|
||||
property Title: String read FTitle write FTitle;
|
||||
|
||||
property HomeAddress: String read FHomeAddress;
|
||||
property HomeCity: String read FHomeCity;
|
||||
property HomeZip: String read FHomeZip;
|
||||
property HomeState: String read FHomeState;
|
||||
property HomeCountry: String read FHomeCountry;
|
||||
property HomeEMail: String read FHomeEMail;
|
||||
property HomePhone: String read FHomePhone;
|
||||
property HomeFax: String read FHomeFax;
|
||||
property Company: String read FCompany write FCompany;
|
||||
property WorkAddress: String read FWorkAddress write FWorkAddress;
|
||||
property WorkCity: String read FWorkCity write FWorkCity;
|
||||
property WorkZip: String read FWorkZip write FWorkZip;
|
||||
property WorkState: String read FWorkState write FWorkState;
|
||||
property WorkCountry: String read FWorkCountry write FWorkCountry;
|
||||
property WorkEMail: String read FWorkEMail write FWorkEMail;
|
||||
property WorkPhone: String read FWorkPhone write FWorkPhone;
|
||||
property WorkFax: String read FWorkFax write FWorkFax;
|
||||
|
||||
property CarPhone: String read FCarPhone;
|
||||
property Mobile: String read FMobile;
|
||||
property ISDN: String read FISDN;
|
||||
property Pager: String read FPager;
|
||||
property HomeAddress: String read FHomeAddress write FHomeAddress;
|
||||
property HomeCity: String read FHomeCity write FHomeCity;
|
||||
property HomeZip: String read FHomeZip write FHomeZip;
|
||||
property HomeState: String read FHomeState write FHomeState;
|
||||
property HomeCountry: String read FHomeCountry write FHomeCountry;
|
||||
property HomeEMail: String read FHomeEMail write FHomeEMail;
|
||||
property HomePhone: String read FHomePhone write FHomePhone;
|
||||
property HomeFax: String read FHomeFax write FHomeFax;
|
||||
|
||||
property CarPhone: String read FCarPhone write FCarPhone;
|
||||
property Mobile: String read FMobile write FMobile;
|
||||
property ISDN: String read FISDN write FISDN;
|
||||
property Pager: String read FPager write FPager;
|
||||
|
||||
property BirthDay: TDateTime read FBirthday write FBirthDay;
|
||||
property Anniversary: TDateTime read FAnniversary write FAnniversary;
|
||||
|
||||
property Version: String read FVersion;
|
||||
property Skip: Boolean read FSkip write FSkip;
|
||||
property Skip: Boolean read FSkip write FSkip; // Flag to skip import
|
||||
end;
|
||||
|
||||
TVpVCards = class
|
||||
@ -99,12 +107,17 @@ type
|
||||
function GetCount: Integer;
|
||||
protected
|
||||
procedure LoadFromStrings(const AStrings: TStrings);
|
||||
procedure SaveToStrings(AList: TStrings);
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Add(ACard: TVpVCard);
|
||||
procedure ClearCards;
|
||||
procedure LoadFromFile(const AFileName: String);
|
||||
procedure LoadFromStream(const AStream: TStream);
|
||||
procedure SaveToFile(const AFileName: String);
|
||||
procedure SaveToStream(const AStream: TStream);
|
||||
property Count: Integer read GetCount;
|
||||
property Card[AIndex: Integer]: TVpVCard read GetCard; default;
|
||||
end;
|
||||
@ -203,6 +216,8 @@ var
|
||||
item: TVpVCardItem;
|
||||
fn, ln, t: String;
|
||||
fullName: String;
|
||||
fs: TFormatSettings;
|
||||
dt: TDateTime;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
@ -221,7 +236,11 @@ begin
|
||||
if FTitle = '' then FTitle := t;
|
||||
end;
|
||||
'ORG':
|
||||
FCompany := item.Value;
|
||||
begin
|
||||
FCompany := item.Value;
|
||||
if (FCompany <> '') and (FCompany[Length(FCompany)] = ';') then
|
||||
Delete(FCompany, Length(FCompany), 1);
|
||||
end;
|
||||
'ADR':
|
||||
if item.Attributes.IndexOf('WORK') <> -1 then
|
||||
VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry)
|
||||
@ -233,10 +252,13 @@ begin
|
||||
else
|
||||
VCardAddress(item.Value, FWorkAddress, FWorkCity, FWorkZip, FWorkState, FWorkCountry);
|
||||
'EMAIL':
|
||||
if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
|
||||
FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + item.Value)
|
||||
if (item.Attributes.IndexOf('WORK') <> -1) then
|
||||
FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + ' ' + item.Value)
|
||||
else
|
||||
FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + item.Value);
|
||||
if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
|
||||
FHomeEMail := IfThen(FHomeEMail = '', item.Value, FHomeEMail + ITEM_SEPARATOR + ' ' + item.Value)
|
||||
else
|
||||
FWorkEMail := IfThen(FWorkEMail = '', item.Value, FWorkEMail + ITEM_SEPARATOR + ' ' + item.Value);
|
||||
'TEL':
|
||||
if item.Attributes.IndexOf('CELL') <> -1 then
|
||||
FMobile := item.Value
|
||||
@ -256,10 +278,26 @@ begin
|
||||
if item.Attributes.IndexOf('ISDN') <> -1 then
|
||||
FISDN := item.Value
|
||||
else
|
||||
if (FCompany = '') or (item.Attributes.IndexOf('HOME') <> -1) then
|
||||
FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + item.Value)
|
||||
if item.Attributes.IndexOf('WORK') <> -1 then
|
||||
FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + ' ' + item.Value)
|
||||
else
|
||||
FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + item.Value);
|
||||
if (item.Attributes.IndexOf('HOME') <> -1) then
|
||||
FHomePhone := IfThen(FHomePhone = '', item.Value, FHomePhone + ITEM_SEPARATOR + ' ' +item.Value)
|
||||
else
|
||||
FWorkPhone := IfThen(FWorkPhone = '', item.Value, FWorkPhone + ITEM_SEPARATOR + ' ' + item.Value);
|
||||
'BDAY', 'ANNIVERSARY':
|
||||
begin
|
||||
fs := FormatSettings;
|
||||
fs.DateSeparator := '-';
|
||||
fs.ShortDateFormat := 'yyyy/mm/dd';
|
||||
if TryStrToDate(item.Value, dt) then
|
||||
begin
|
||||
if (item.Key = 'BDAY') then
|
||||
FBirthday := dt
|
||||
else if (item.Key = 'ANNIVERSARY') then
|
||||
FAnniversary := dt;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -277,19 +315,12 @@ begin
|
||||
end;
|
||||
|
||||
function TVpVCard.GetEMail: String;
|
||||
var
|
||||
sw, sh: String;
|
||||
begin
|
||||
if WorkEMail <> '' then sw := Format('%s (work)', [WorkEMail]) else sw := '';
|
||||
if HomeEMail <> '' then sh := Format('%s (home)', [HomeEMail]) else sh := '';
|
||||
if (sw <> '') and (sh <> '') then
|
||||
Result := sw + '; ' + sh
|
||||
else if (sw <> '') then
|
||||
Result := sw
|
||||
else if (sh <> '') then
|
||||
Result := sh
|
||||
else
|
||||
Result := '';
|
||||
Result := '';
|
||||
if WorkEMail <> '' then Result := Format('%s; %s (work)', [Result, WorkEMail]);
|
||||
if HomeEMail <> '' then Result := Format('%s; %s (home)', [Result, HomeEMail]);
|
||||
if Result <> '' then
|
||||
Delete(Result, 1, 2);
|
||||
end;
|
||||
|
||||
function TVpVCard.GetFullName: String;
|
||||
@ -312,19 +343,12 @@ begin
|
||||
end;
|
||||
|
||||
function TVpVCard.GetPhone: String;
|
||||
var
|
||||
sw, sh: String;
|
||||
begin
|
||||
if WorkPhone <> '' then sw := Format('%s (work)', [WorkPhone]) else sw := '';
|
||||
if HomePhone <> '' then sh := Format('%s (home)', [HomePhone]) else sh := '';
|
||||
if (sw <> '') and (sh <> '') then
|
||||
Result := sw + '; ' + sh
|
||||
else if (sw <> '') then
|
||||
Result := sw
|
||||
else if (sh <> '') then
|
||||
Result := sh
|
||||
else
|
||||
Result := '';
|
||||
Result := '';
|
||||
if WorkPhone <> '' then Result := Format('%s; %s (work)', [Result, WorkPhone]);
|
||||
if HomePhone <> '' then Result := Format('%s; %s (home)', [Result, HomePhone]);
|
||||
if Mobile <> '' then Result := Format('%s; %s (mobile)', [Result, Mobile]);
|
||||
if Result <> '' then Delete(Result, 1, 2);
|
||||
end;
|
||||
|
||||
function TVpVCard.GetWorkAddress: String;
|
||||
@ -339,33 +363,63 @@ begin
|
||||
if WorkCountry <> '' then
|
||||
Result := Result + ', ' + WorkCountry;
|
||||
end;
|
||||
(*
|
||||
function GetHomeAddress: String;
|
||||
function GetWorkAddress: String;
|
||||
|
||||
property FirstName: String read FFirstName;
|
||||
property LastName: String read FLastName;
|
||||
property Title: String read FTitle;
|
||||
procedure TVpVCard.SaveToStrings(AList: TStrings);
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
AList.Add('BEGIN:VCARD');
|
||||
AList.Add('VERSION:3.0');
|
||||
|
||||
property Company: String read FCompany;
|
||||
property WorkAddress: String read FWorkAddress;
|
||||
property WorkCity: String read FWorkCity;
|
||||
property WorkZip: String read FWorkZip;
|
||||
property WorkState: String read FWorkState;
|
||||
property WorkCountry: String read FWorkCountry;
|
||||
property WorkEMail: String read FWorkEMail;
|
||||
property WorkPhone: String read FWorkPhone;
|
||||
property WorkFax: String read FWorkFax;
|
||||
// Name
|
||||
AList.Add('FN:' + GetFullName);
|
||||
AList.Add('N:' + LastName + ';' + FirstName + ';;;');
|
||||
|
||||
// Addresses
|
||||
if (WorkAddress <> '') or (WorkCity <> '') or (WorkZip <> '') or
|
||||
(WorkState <> '') or (WorkCountry <> '')
|
||||
then
|
||||
AList.Add('ADR;TYPE=WORK:' + WorkAddress + ';' + WorkCity + ';' +
|
||||
WorkState +';' + WorkZip + ';' + WorkCountry);
|
||||
if (HomeAddress <> '') or (HomeCity <> '') or (HomeZip <> '') or
|
||||
(HomeState <> '') or (HomeCountry <> '')
|
||||
then
|
||||
AList.Add('ADR;TYPE=HOME:' + HomeAddress + ';' + HomeCity + ';' +
|
||||
HomeState +';' + HomeZip + ';' + HomeCountry);
|
||||
|
||||
// Company
|
||||
if Company <> '' then
|
||||
AList.Add('ORG:' + Company);
|
||||
|
||||
// Phone numbers
|
||||
if WorkPhone <> '' then
|
||||
AList.Add('TEL;TYPE=WORK:' + WorkPhone);
|
||||
if HomePhone <> '' then
|
||||
AList.Add('TEL;TYPE=HOME:' + HomePhone);
|
||||
if Mobile <> '' then
|
||||
AList.Add('TEL;TYPE=CELL:' + Mobile);
|
||||
if CarPhone <> '' then
|
||||
AList.Add('TEL;TYPE=CAR:' + CarPhone);
|
||||
if ISDN <> '' then
|
||||
AList.Add('TEL;TYPE=ISDN:' + ISDN);
|
||||
if Pager <> '' then
|
||||
AList.Add('TEL;TYPE=PAGER:' + Pager);
|
||||
|
||||
// Fax
|
||||
if WorkFax <> '' then
|
||||
AList.Add('TEL;TYPE="fax,work":' + WorkFax);
|
||||
if HomeFax <> '' then
|
||||
AList.Add('TEL;TYPE="fax,home":' + HomeFax);
|
||||
|
||||
// E-Mail
|
||||
if WorkEMail <> '' then
|
||||
AList.Add('EMAIL;TYPE=WORK:' + WorkEMail);
|
||||
if HomeEMail <> '' then
|
||||
AList.Add('EMAIL;TYPE=HOME:' + HomeEMail);
|
||||
|
||||
AList.Add('END:VCARD');
|
||||
end;
|
||||
|
||||
property HomeAddress: String read FHomeAddress;
|
||||
property HomeCity: String read FHomeCity;
|
||||
property HomeZip: String read FHomeZip;
|
||||
property HomeState: String read FHomeState;
|
||||
property HomeCountry: String read FHomeCountry;
|
||||
property HomeEMail: String read FHomeEMail;
|
||||
property HomePhone: String read FHomePhone;
|
||||
property HomeFax: String read FHomeFax;
|
||||
*)
|
||||
|
||||
{==============================================================================}
|
||||
{ TVpCards }
|
||||
@ -383,6 +437,15 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TVpVCards.Add(ACard: TVpVCard);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
n := Length(FCards);
|
||||
SetLength(FCards, n+1);
|
||||
FCards[n] := ACard;
|
||||
end;
|
||||
|
||||
procedure TVpVCards.ClearCards;
|
||||
var
|
||||
j: Integer;
|
||||
@ -466,5 +529,40 @@ begin
|
||||
SetLength(FCards, n);
|
||||
end;
|
||||
|
||||
procedure TVpVCards.SaveToFile(const AFileName: String);
|
||||
var
|
||||
L: TStrings;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
try
|
||||
SaveToStrings(L);
|
||||
L.SaveToFile(AFileName);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpVCards.SaveToStream(const AStream: TStream);
|
||||
var
|
||||
L: TStrings;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
try
|
||||
SaveToStrings(L);
|
||||
L.SaveToStream(AStream);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpVCards.SaveToStrings(AList: TStrings);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
AList.clear;
|
||||
for i := 0 to Count-1 do
|
||||
FCards[i].SaveToStrings(AList);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user