diff --git a/demos/calendar_demo/CelendarAPI.dproj b/demos/calendar_demo/CelendarAPI.dproj index 7803ee3..2d106c9 100644 --- a/demos/calendar_demo/CelendarAPI.dproj +++ b/demos/calendar_demo/CelendarAPI.dproj @@ -1,115 +1,115 @@ - - - {9F62CA46-D0D3-4082-A250-5A01F95A583F} - 12.0 - CelendarAPI.dpr - Debug - DCC32 - - - true - - - true - Base - true - - - true - Base - true - - - CelendarAPI.exe - 00400000 - WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) - x86 - false - false - false - false - false - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - - - - MainSource - - -
Form1
- - - - - - - -
Form2
- - - - Base - - - Cfg_2 - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - CelendarAPI.dpr - - - False - True - False - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1049 - 1251 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - 12 - - + + + {9F62CA46-D0D3-4082-A250-5A01F95A583F} + 12.0 + CelendarAPI.dpr + Debug + DCC32 + + + true + + + true + Base + true + + + true + Base + true + + + CelendarAPI.exe + 00400000 + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) + x86 + false + false + false + false + false + + + false + RELEASE;$(DCC_Define) + 0 + false + + + DEBUG;$(DCC_Define) + + + + MainSource + + +
Form1
+ + + + + + + +
Form2
+ + + + Base + + + Cfg_2 + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + CelendarAPI.dpr + + + False + True + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + 12 + + diff --git a/demos/googlelogin_demo/Demo.dproj b/demos/googlelogin_demo/Demo.dproj index faa96a0..d03b1cb 100644 --- a/demos/googlelogin_demo/Demo.dproj +++ b/demos/googlelogin_demo/Demo.dproj @@ -1,3 +1,4 @@ +<<<<<<< HEAD  {A9DD61E1-1C1A-4F97-801D-FA2DE517335B} @@ -104,3 +105,108 @@ 12 +======= + + + {A9DD61E1-1C1A-4F97-801D-FA2DE517335B} + 12.0 + Demo.dpr + Debug + DCC32 + + + true + + + true + Base + true + + + true + Base + true + + + vcl;rtl;vclx;vclimg;vclactnband;dbrtl;vcldb;vcldbx;bdertl;vcltouch;xmlrtl;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;WDSearchStat;CompThread;Package1 + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) + Demo.exe + 00400000 + x86 + + + false + RELEASE;$(DCC_Define) + 0 + false + + + DEBUG;$(DCC_Define) + + + + MainSource + + +
Form11
+ + + Base + + + Cfg_2 + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + False + True + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + Demo.dpr + + + + 12 + + +>>>>>>> remotes/origin/NMD diff --git a/demos/googlelogin_demo/main.dfm b/demos/googlelogin_demo/main.dfm index 61b7ea8..e975923 100644 --- a/demos/googlelogin_demo/main.dfm +++ b/demos/googlelogin_demo/main.dfm @@ -2,8 +2,8 @@ object Form11: TForm11 Left = 0 Top = 0 Caption = 'Google Login' - ClientHeight = 167 - ClientWidth = 340 + ClientHeight = 524 + ClientWidth = 355 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -55,12 +55,48 @@ object Form11: TForm11 Height = 13 Caption = 'AUTH' end + object Label7: TLabel + Left = 8 + Top = 168 + Width = 61 + Height = 13 + Caption = 'TLoginResult' + end + object Label8: TLabel + Left = 8 + Top = 195 + Width = 31 + Height = 13 + Caption = 'Label8' + end + object Label9: TLabel + Left = 8 + Top = 264 + Width = 162 + Height = 13 + Caption = #1051#1086#1075' '#1082#1086#1083'-'#1074#1072' '#1087#1086#1083#1091#1095#1077#1085#1085#1099#1093' '#1076#1072#1085#1085#1099#1093 + end + object Label10: TLabel + Left = 8 + Top = 222 + Width = 114 + Height = 13 + Caption = #1055#1088#1086#1075#1088#1077#1089#1089' '#1072#1074#1090#1086#1088#1080#1079#1072#1094#1080#1080 + end + object Image1: TImage + Left = 8 + Top = 359 + Width = 241 + Height = 74 + AutoSize = True + end object EmailEdit: TEdit Left = 38 Top = 27 Width = 121 Height = 21 TabOrder = 0 + Text = 'GoLabApi@gmail.com' end object PassEdit: TEdit Left = 213 @@ -68,13 +104,14 @@ object Form11: TForm11 Width = 121 Height = 21 TabOrder = 1 + Text = '123456789her' end object Button1: TButton - Left = 120 + Left = 8 Top = 84 - Width = 75 + Width = 170 Height = 21 - Caption = 'Connect' + Caption = #1051#1086#1075#1080#1085#1080#1084#1089#1103 TabOrder = 2 OnClick = Button1Click end @@ -110,24 +147,94 @@ object Form11: TForm11 'YouTube Data API') end object AuthEdit: TEdit - Left = 68 + Left = 84 Top = 138 Width = 264 Height = 21 TabOrder = 4 end object ResultEdit: TEdit - Left = 68 + Left = 84 Top = 111 Width = 264 Height = 21 TabOrder = 5 end + object Button2: TButton + Left = 184 + Top = 84 + Width = 163 + Height = 21 + Caption = #1069#1082#1089#1090#1088#1077#1085#1085#1086#1077' '#1090#1086#1088#1084#1086#1078#1077#1085#1080#1077' '#1087#1086#1090#1086#1082#1072 + TabOrder = 6 + OnClick = Button2Click + end + object Edit1: TEdit + Left = 84 + Top = 165 + Width = 264 + Height = 21 + TabOrder = 7 + end + object Edit2: TEdit + Left = 84 + Top = 192 + Width = 264 + Height = 21 + TabOrder = 8 + Text = 'Edit2' + end + object ProgressBar1: TProgressBar + Left = 8 + Top = 241 + Width = 339 + Height = 17 + TabOrder = 9 + end + object Memo1: TMemo + Left = 8 + Top = 283 + Width = 339 + Height = 70 + TabOrder = 10 + end + object Animate1: TAnimate + Left = 8 + Top = 466 + Width = 80 + Height = 50 + CommonAVI = aviFindFolder + DoubleBuffered = False + ParentDoubleBuffered = False + StopFrame = 29 + Timers = True + end + object Edit3: TEdit + Left = 208 + Top = 456 + Width = 121 + Height = 21 + TabOrder = 12 + Text = 'Edit3' + end + object Button3: TButton + Left = 216 + Top = 488 + Width = 75 + Height = 25 + Caption = 'Button3' + TabOrder = 13 + OnClick = Button3Click + end object GoogleLogin1: TGoogleLogin - AccountType = atHOSTED_OR_GOOGLE - Service = tsNone - OnAfterLogin = GoogleLogin1AfterLogin - Left = 256 - Top = 4 + AppName = + 'Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.6) Gecko/2' + + '0100625 Firefox/3.6.6' + AccountType = atNone + OnAutorization = GoogleLogin1Autorization + OnAutorizCaptcha = GoogleLogin1AutorizCaptcha + OnProgressAutorization = GoogleLogin1ProgressAutorization + Left = 176 + Top = 8 end end diff --git a/demos/googlelogin_demo/main.pas b/demos/googlelogin_demo/main.pas index 58af92a..bb95c9d 100644 --- a/demos/googlelogin_demo/main.pas +++ b/demos/googlelogin_demo/main.pas @@ -1,10 +1,10 @@ -unit main; +unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, uGoogleLogin; + Dialogs, StdCtrls, uGoogleLogin,TypInfo, ComCtrls, ExtCtrls; type TForm11 = class(TForm) @@ -14,16 +14,35 @@ TForm11 = class(TForm) PassEdit: TEdit; Button1: TButton; Label4: TLabel; - GoogleLogin1: TGoogleLogin; Label3: TLabel; Label5: TLabel; ComboBox1: TComboBox; Label6: TLabel; AuthEdit: TEdit; ResultEdit: TEdit; + Button2: TButton; + GoogleLogin1: TGoogleLogin; + Edit1: TEdit; + Label7: TLabel; + Edit2: TEdit; + Label8: TLabel; + ProgressBar1: TProgressBar; + Memo1: TMemo; + Label9: TLabel; + Label10: TLabel; + Animate1: TAnimate; + Image1: TImage; + Edit3: TEdit; + Button3: TButton; procedure Button1Click(Sender: TObject); - procedure GoogleLogin1AfterLogin(const LoginResult: TLoginResult; - LoginStr: string); + procedure GoogleLogin1Autorization(const LoginResult: TLoginResult; + Result: TResultRec); + procedure GoogleLogin1Error(const ErrorStr: string); + procedure Button2Click(Sender: TObject); + procedure GoogleLogin1Disconnect(const ResultStr: string); + procedure GoogleLogin1ProgressAutorization(const Progress, MaxProgress: Integer); + procedure GoogleLogin1AutorizCaptcha(PicCaptcha: TPicture); + procedure Button3Click(Sender: TObject); private { Private declarations } public @@ -43,14 +62,65 @@ procedure TForm11.Button1Click(Sender: TObject); GoogleLogin1.Email:=EmailEdit.Text; GoogleLogin1.Password:=PassEdit.Text; GoogleLogin1.Service:=TServices(ComboBox1.ItemIndex); +Memo1.Clear;//очистка лога GoogleLogin1.Login(); end; -procedure TForm11.GoogleLogin1AfterLogin(const LoginResult: TLoginResult; - LoginStr: string); +procedure TForm11.Button2Click(Sender: TObject); +begin + GoogleLogin1.Destroy; +end; + +procedure TForm11.Button3Click(Sender: TObject); +begin + //Memo1.Lines.Add(GoogleLogin1.CapchaToken); + GoogleLogin1.Captcha:=Edit3.Text; + +end; + +procedure TForm11.GoogleLogin1Autorization(const LoginResult: TLoginResult;Result: TResultRec); +var + temp:string; +begin + ResultEdit.Text:=Result.LoginStr; + AuthEdit.Text:=Result.Auth; + temp:=GetEnumName(TypeInfo(TLoginResult),Integer(LoginResult)); + Edit1.Text:=temp; + Edit2.Text:=Result.SID; + if LoginResult =lrOk then + ShowMessage('Мы в гугле!!!!!!!!!') + else + ShowMessage('Мы НЕ в гугле!!!!!!!!!'); + +end; + +procedure TForm11.GoogleLogin1AutorizCaptcha(PicCaptcha: TPicture); +begin + Image1.Picture:=PicCaptcha; +end; + +procedure TForm11.GoogleLogin1Disconnect(const ResultStr: string); +begin + ShowMessage('Disconnect'); +end; + +procedure TForm11.GoogleLogin1Error(const ErrorStr: string); +begin + ShowMessage(ErrorStr); +end; + +procedure TForm11.GoogleLogin1ProgressAutorization(const Progress, MaxProgress: Integer); begin - ResultEdit.Text:=LoginStr; - AuthEdit.Text:=GoogleLogin1.Auth; + ProgressBar1.Position:=Progress; + ProgressBar1.Max:=MaxProgress; + Memo1.Lines.Add('////////'); + Memo1.Lines.Add('Progress '+IntToStr(Progress)); + Memo1.Lines.Add('MaxProgress '+IntToStr(MaxProgress)); + //слишком уж быстро качает я не увидел чтоб анимация работала + if (MaxProgress>Progress) then + Animate1.Active:=True + else + Animate1.Active:=False; end; end. diff --git a/packages/googleLogin_pack/GoogleLogin.dpk b/packages/googleLogin_pack/GoogleLogin.dpk index 99034b8..277156e 100644 --- a/packages/googleLogin_pack/GoogleLogin.dpk +++ b/packages/googleLogin_pack/GoogleLogin.dpk @@ -26,7 +26,8 @@ package GoogleLogin; requires rtl, - vcl; + vcl, + vclimg; contains uGoogleLogin in 'uGoogleLogin.pas'; diff --git a/packages/googleLogin_pack/GoogleLogin.dproj b/packages/googleLogin_pack/GoogleLogin.dproj index 0eb8745..390c75b 100644 --- a/packages/googleLogin_pack/GoogleLogin.dproj +++ b/packages/googleLogin_pack/GoogleLogin.dproj @@ -21,7 +21,7 @@ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) - C:\Users\Public\Documents\RAD Studio\7.0\Bpl\GoogleLogin.bpl + C:\Documents and Settings\All Users\Документы\RAD Studio\7.0\Bpl\GoogleLogin.bpl 0 true true @@ -43,6 +43,7 @@ + Base @@ -97,10 +98,7 @@ 1.0.0.0 - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - + 12 diff --git a/packages/googleLogin_pack/GoogleLogin.identcache b/packages/googleLogin_pack/GoogleLogin.identcache new file mode 100644 index 0000000..e52352b Binary files /dev/null and b/packages/googleLogin_pack/GoogleLogin.identcache differ diff --git a/packages/googleLogin_pack/uGoogleLogin.pas b/packages/googleLogin_pack/uGoogleLogin.pas index 4bd8d71..b87b98d 100644 --- a/packages/googleLogin_pack/uGoogleLogin.pas +++ b/packages/googleLogin_pack/uGoogleLogin.pas @@ -1,140 +1,216 @@ -{*******************************************************} -{ } -{ Delphi & Google API } -{ } -{ File: uGoogleLogin } -{ Copyright (c) WebDelphi.ru } -{ All Rights Reserved. } -{ } -{ } -{ } -{*******************************************************} - -{*******************************************************} -{ GoogleLogin Component } -{*******************************************************} +{ ******************************************************* } +{ } +{ Delphi & Google API } +{ } +{ File: uGoogleLogin } +{ Copyright (c) WebDelphi.ru } +{ All Rights Reserved. } +{ не обижайтесь писал на большом мониторе} +{ на счет комментариев, пишу много чтоб было понятно всем} +{ NMD} +{ ******************************************************* } + +{ ******************************************************* } +{ GoogleLogin Component } +{ ******************************************************* } unit uGoogleLogin; interface -uses WinInet, StrUtils, SysUtils, Classes; +uses WinInet, StrUtils,Graphics, SysUtils, Classes, Windows, TypInfo,jpeg; +//jpeg для поддержки формата jpeg +//Graphics для поддержки формата TPicture resourcestring - rcNone = ' '; - rcOk = ' '; - rcBadAuthentication =' , '; - rcNotVerified =' , , '; - rcTermsNotAgreed =' '; - rcCaptchaRequired =' CAPTCHA'; - rcUnknown =' '; - rcAccountDeleted =' '; - rcAccountDisabled =' '; - rcServiceDisabled =' '; - rcServiceUnavailable =' , '; - rcDisconnect =' '; + rcNone = 'Аутентификация не производилась или сброшена'; + rcOk = 'Аутентификация прошла успешно'; + rcBadAuthentication = 'Не удалось распознать имя пользователя или пароль, использованные в запросе на вход'; + rcNotVerified = 'Адрес электронной почты, связанный с аккаунтом, не был подтвержден'; + rcTermsNotAgreed = 'Пользователь не принял условия использования службы'; + rcCaptchaRequired = 'Требуется ответ на тест CAPTCHA'; + rcUnknown = 'Неизвестная ошибка'; + rcAccountDeleted = 'Аккаунт этого пользователя удален'; + rcAccountDisabled = 'Аккаунт этого пользователя отключен'; + rcServiceDisabled = 'Доступ пользователя к указанной службе запрещен'; + rcServiceUnavailable = 'Служба недоступна, повторите попытку позже'; + rcDisconnect = 'Соединение с сервером разорвано'; + // ошибки соединения + rcErrServer = 'На сервере произошла ошибка #'; + rcErrDont = 'Не могу получить описание ошибки'; const - DefaultAppName = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.6) Gecko/20100625 Firefox/3.6.6'; + // дефолное название приложение через которое якобы происходит соединение с сервером гугла + DefaultAppName ='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.6) Gecko/20100625 Firefox/3.6.6'; + // настройки wininet для работы с ssl Flags_Connection = INTERNET_DEFAULT_HTTPS_PORT; - Flags_Request = INTERNET_FLAG_RELOAD or - INTERNET_FLAG_IGNORE_CERT_CN_INVALID or - INTERNET_FLAG_NO_CACHE_WRITE or - INTERNET_FLAG_SECURE or - INTERNET_FLAG_PRAGMA_NOCACHE or - INTERNET_FLAG_KEEP_CONNECTION; - - Errors : array [0..8] of string = ('BadAuthentication','NotVerified', - 'TermsNotAgreed','CaptchaRequired','Unknown','AccountDeleted', - 'AccountDisabled', 'ServiceDisabled','ServiceUnavailable'); + Flags_Request =INTERNET_FLAG_RELOAD or + INTERNET_FLAG_IGNORE_CERT_CN_INVALID or + INTERNET_FLAG_NO_CACHE_WRITE or + INTERNET_FLAG_SECURE or + INTERNET_FLAG_PRAGMA_NOCACHE or + INTERNET_FLAG_KEEP_CONNECTION; + // ошибки при авторизации + Errors: array [0 .. 8] of string = ('BadAuthentication', 'NotVerified', + 'TermsNotAgreed', 'CaptchaRequired', 'Unknown', 'AccountDeleted', + 'AccountDisabled', 'ServiceDisabled', 'ServiceUnavailable'); type - TAccountType = (atNone ,atGOOGLE, atHOSTED, atHOSTED_OR_GOOGLE); + TAccountType = (atNone, atGOOGLE, atHOSTED, atHOSTED_OR_GOOGLE); type - TLoginResult = (lrNone,lrOk, lrBadAuthentication, lrNotVerified, - lrTermsNotAgreed, lrCaptchaRequired, lrUnknown, - lrAccountDeleted, lrAccountDisabled, lrServiceDisabled, - lrServiceUnavailable); + TLoginResult = (lrNone, lrOk, lrBadAuthentication, lrNotVerified, + lrTermsNotAgreed, lrCaptchaRequired, lrUnknown, lrAccountDeleted, + lrAccountDisabled, lrServiceDisabled, lrServiceUnavailable); type - TServices = (tsNone,tsAnalytics,tsApps,tsGBase,tsSites,tsBlogger,tsBookSearch, - tsCelendar,tcCodeSearch,tsContacts,tsDocLists,tsFinance, - tsGMailFeed,tsHealth,tsMaps,tsPicasa,tsSidewiki,tsSpreadsheets, - tsWebmaster,tsYouTube); + // xapi - это универсальное имя - когда юзер не знает какой сервис ему нужен, то втыкает xapi и просто коннектится к Гуглу + TServices = (xapi, analytics, apps, gbase, jotspot, blogger, print, cl, + codesearch, cp, writely, finance, mail, health, local, lh2, annotateweb, + wise, sitemaps, youtube); +type + TStatusThread = (sttActive,sttNoActive);//статус потока -const - ServiceIDs: array[0..19]of string=('xapi','analytics','apps','gbase', - 'jotspot','blogger','print','cl','codesearch','cp','writely','finance', - 'mail','health','local','lh2','annotateweb','wise','sitemaps','youtube'); +type + TResultRec = packed record + LoginStr: string; // текстовый результат авторизации + SID: string; // в настоящее время не используется + LSID: string; // в настоящее время не используется + Auth: string; + end; type - TAfterLogin = procedure (const LoginResult: TLoginResult; LoginStr:string)of object; - TDisconnect = procedure (const ResultStr:string)of object; + TAutorization = procedure(const LoginResult: TLoginResult; Result: TResultRec) of object; // авторизировались + //непосредственно само изображение капчи + TAutorizCaptcha = procedure(PicCaptcha:TPicture) of object; // не авторизировались нужно ввести капчу + + //Progress,MaxProgress переменные которые специально заведены для прогрессбара Progress-текущее состояние MaxProgress-максимальное значение + TProgressAutorization = procedure(const Progress,MaxProgress:Integer)of object;//показываем прогресс при авторизации + TErrorAutorization = procedure(const ErrorStr: string) of object; // а это не авторизировались)) + TDisconnect = procedure(const ResultStr: string) of object; + TDoneThread = procedure(const Status: TStatusThread) of object; type + // поток используется только для получения HTML страницы + TGoogleLoginThread = class(TThread) + private + FParentComp:TComponent; + { private declarations } + FParamStr: string; // параметры запроса + + // данные ответа/запроса + FResultRec: TResultRec; // структура для передачи результатов + FLastResult: TLoginResult; // результаты авторизации + + FCaptchaPic:TPicture;//изображение капчи + FCaptchaURL: string; + FCapthaToken: string; + //для прогресса + FProgress,FMaxProgress:Integer; + //переменные для событий + FAutorization: TAutorization; // авторизация + FAutorizCaptcha:TAutorizCaptcha;//не авторизировались необходимо ввести капчу + FProgressAutorization:TProgressAutorization;//прогресс при авторизации для показа часиков и подобных вещей + FErrorAutorization: TErrorAutorization;//ошибка при авторизации + + function ExpertLoginResult(const LoginResult: string): TLoginResult; // анализ результата авторизации + function GetLoginError(const str: string): TLoginResult;// получаем тип ошибки + + function GetCaptchaURL(const cList: TStringList): string; // ссылка на капчу + function GetCaptchaToken(const cList: TStringList): String; + + function GetResultText: string; + + function GetErrorText(const FromServer: BOOLEAN): string;// получаем текст ошибки + function LoadCaptcha(aCaptchaURL:string):Boolean;//загрузка капчи + + + procedure SynAutoriz; // передача значения авторизации в главную форму как положено в потоке + procedure SynCaptcha; //передача значения авторизации в главную форму как положено в потоке о том что необходимо ввести капчу + procedure SynCapchaToken;//передача значения в свойство шкурки + procedure SynProgressAutoriz;// передача текушего прогресса авторизации в главную форму как положено в потоке + procedure SynErrAutoriz; // передача значения ошибки в главную форму как положено в потоке + protected + { protected declarations } + public + { public declarations } + constructor Create(CreateSuspennded: BOOLEAN; aParamStr: string;aParentComp:TComponent); // используем для передачи логина и пароля и подобного + procedure Execute; override; // выполняем непосредственно авторизацию на сайте + published + { published declarations } + // события + property OnAutorization:TAutorization read FAutorization write FAutorization; // авторизировались + property OnAutorizCaptcha:TAutorizCaptcha read FAutorizCaptcha write FAutorizCaptcha; //не авторизировались необходимо ввести капчу + property OnProgressAutorization: TProgressAutorization read FProgressAutorization write FProgressAutorization;//прогресс авторизации + property OnError: TErrorAutorization read FErrorAutorization write FErrorAutorization; // возникла ошибка (( + end; + + // "шкурка" компонента TGoogleLogin = class(TComponent) private - // - FAppname : string; // , , . - FAccountType : TAccountType; - FLastResult : TLoginResult; - FEmail : string; - FPassword : string; - // / - FSID : string;// - FLSID : string;// - FAuth : string; - FService : TServices;// - FSource : string;// - FLogintoken : string; - FLogincaptcha : string; - // Captcha - FCaptchaURL : string; - FAfterLogin : TAfterLogin; - FDisconnect : TDisconnect; - function SendRequest(const ParamStr: string):AnsiString; - function ExpertLoginResult(const LoginResult:string):TLoginResult; - function GetLoginError(const str: string):TLoginResult; - function GetCaptchaToken(const cList:TStringList):String; - function GetCaptchaURL(const cList:TStringList):string; - function GetResultText:string; - procedure SetEmail(cEmail:string); - procedure SetPassword(cPassword:string); - procedure SetService(cService:TServices); - procedure SetSource(cSource: string); - procedure SetCaptcha(cCaptcha:string); - procedure SetAppName(value:string); - //////////////// ////////////////////////// + // Поток + FThread: TGoogleLoginThread; + // регистрационные данные + FAppname: string; // строка символов, которая передается серверу и идентифицирует программное обеспечение, пославшее запрос. + FAccountType: TAccountType; + FLastResult: TLoginResult; + FEmail: string; + FPassword: string; + // данные ответа/запроса + FService: TServices; // сервис к которому необходимо получить доступ + // параметры Captcha +// FCaptchaURL: string;//ссылка на капчу + FCaptcha: string; //Captcha + FCapchaToken: string; + //FStatus:TStatusThread;//статус потока + //переменные для событий + FAfterLogin: TAutorization;//авторизировались + FAutorizCaptcha:TAutorizCaptcha;//не авторизировались необходимо ввести капчу + FProgressAutorization:TProgressAutorization;//прогресс при авторизации для показа часиков и подобных вещей + FErrorAutorization: TErrorAutorization; + FDisconnect: TDisconnect; + + function SendRequest(const ParamStr: string): AnsiString; + // отправляем запрос на сервер + procedure SetEmail(cEmail: string); + procedure SetPassword(cPassword: string); + procedure SetService(cService: TServices); + procedure SetCaptcha(cCaptcha: string); + procedure SetAppName(value: string); + /// /////////////вспомогательные функции////////////////////////// function DigitToHex(Digit: Integer): Char; - // url + // кодирование url function URLEncode(const S: string): string; - // url - function URLDecode(const S: string): string; + // декодирование url + function URLDecode(const S: string): string; // не используется public - constructor Create(AOwner: TComponent);override; - function Login(aLoginToken:string='';aLoginCaptcha:string=''):TLoginResult;overload; - procedure Disconnect;// - property LastResult: TLoginResult read FLastResult; - property LastResultText:string read GetResultText; - property Auth: string read FAuth; - property SID: string read FSID; - property LSID: string read FLSID; - property CaptchaURL: string read FCaptchaURL; - property LoginToken: string read FLogintoken; - property LoginCaptcha: string read FLogincaptcha write FLogincaptcha; + constructor Create(AOwner: TComponent); override; + destructor Destroy;//глушим все + procedure Login(aLoginToken: string = ''; aLoginCaptcha: string = ''); + // формируем запрос + procedure Disconnect; // удаляет все данные по авторизации + //property LastResult: TLoginResult read FLastResult;//убрал за ненадобностью по причине того что все передается в SynAutoriz + // property Auth: string read FAuth; + // property SID: string read FSID; + // property LSID: string read FLSID; + // property CaptchaURL: string read FCaptchaURL; + property CapchaToken: string read FCapchaToken; published - property AppName:string read FAppname write SetAppName; + property AppName: string read FAppname write SetAppName; property AccountType: TAccountType read FAccountType write FAccountType; property Email: string read FEmail write SetEmail; - property Password:string read FPassword write SetPassword; - property Service: TServices read FService write SetService; - property Source: string read FSource write FSource; - property OnAfterLogin :TAfterLogin read FAfterLogin write FAfterLogin; + property Password: string read FPassword write SetPassword; + property Captcha: string read FCaptcha write SetCaptcha; + property Service: TServices read FService write SetService default xapi; + //property Status:TStatusThread read FStatus default sttNoActive;//статус потока + property OnAutorization: TAutorization read FAfterLogin write FAfterLogin;// авторизировались + property OnAutorizCaptcha:TAutorizCaptcha read FAutorizCaptcha write FAutorizCaptcha; //не авторизировались необходимо ввести капчу + property OnProgressAutorization:TProgressAutorization read FProgressAutorization write FProgressAutorization;//прогресс авторизации + property OnError: TErrorAutorization read FErrorAutorization write FErrorAutorization; // возникла ошибка (( property OnDisconnect: TDisconnect read FDisconnect write FDisconnect; -end; + end; procedure Register; @@ -142,7 +218,7 @@ implementation procedure Register; begin - RegisterComponents('WebDelphi.ru',[TGoogleLogin]); + RegisterComponents('WebDelphi.ru', [TGoogleLogin]); end; { TGoogleLogin } @@ -150,8 +226,10 @@ procedure Register; function TGoogleLogin.DigitToHex(Digit: Integer): Char; begin case Digit of - 0..9: Result := Chr(Digit + Ord('0')); - 10..15: Result := Chr(Digit - 10 + Ord('A')); + 0 .. 9: + Result := Chr(Digit + Ord('0')); + 10 .. 15: + Result := Chr(Digit - 10 + Ord('A')); else Result := '0'; end; @@ -159,241 +237,116 @@ function TGoogleLogin.DigitToHex(Digit: Integer): Char; procedure TGoogleLogin.Disconnect; begin - FAccountType:=atNone; - FLastResult:=lrNone; - FSID:=''; - FLSID:=''; - FAuth:=''; - FLogintoken:=''; - FLogincaptcha:=''; - FCaptchaURL:=''; - FLogintoken:=''; + FAccountType := atNone; + FLastResult := lrNone; + // FSID:=''; + //FLSID:=''; + //FAuth:=''; + FCapchaToken := ''; + FCaptcha := ''; + //FCaptchaURL := ''; + if Assigned(FThread) then + FThread.Terminate; if Assigned(FDisconnect) then OnDisconnect(rcDisconnect) end; -constructor TGoogleLogin.Create(AOwner: TComponent); +destructor TGoogleLogin.Destroy; begin - inherited Create(AOwner); - FAppname:=DefaultAppName;// + if Assigned(FThread) then + FThread.Terminate; + inherited Destroy; end; -function TGoogleLogin.ExpertLoginResult(const LoginResult: string): TLoginResult; -var List: TStringList; - i:integer; -begin -// - List:=TStringList.Create; - List.Text:=LoginResult; -// -if pos('error',LowerCase(LoginResult))>0 then // - begin - for i:=0 to List.Count-1 do - begin - if pos('error',LowerCase(List[i]))>0 then // - begin - Result:=GetLoginError(List[i]);// - break; - end; - end; - if Result=lrCaptchaRequired then // - begin - FCaptchaURL:=GetCaptchaURL(List); - FLogintoken:=GetCaptchaToken(List); - end; - end -else - begin - Result:=lrOk; - for i:=0 to List.Count-1 do - begin - if pos('SID',UpperCase(List[i]))>0 then - FSID:=Trim(copy(List[i],pos('=',List[i])+1,Length(List[i])-pos('=',List[i]))) - else - if pos('LSID',UpperCase(List[i]))>0 then - FLSID:=Trim(copy(List[i],pos('=',List[i])+1,Length(List[i])-pos('=',List[i]))) - else - if pos('AUTH',UpperCase(List[i]))>0 then - FAuth:=Trim(copy(List[i],pos('=',List[i])+1,Length(List[i])-pos('=',List[i]))); - end; - end; -FreeAndNil(List); -end; - -function TGoogleLogin.GetCaptchaToken(const cList: TStringList): String; -var i:integer; -begin - for I := 0 to cList.Count - 1 do - begin - if pos('captchatoken',lowerCase(cList[i]))>0 then - begin - Result:=Trim(copy(cList[i],pos('=',cList[i])+1,Length(cList[i])-pos('=',cList[i]))); - break; - end; - end; -end; - -function TGoogleLogin.GetCaptchaURL(const cList: TStringList): string; -var i:integer; -begin - for I := 0 to cList.Count - 1 do - begin - if pos('captchaurl',lowerCase(cList[i]))>0 then - begin - Result:=Trim(copy(cList[i],pos('=',cList[i])+1,Length(cList[i])-pos('=',cList[i]))); - break; - end; - end; -end; - -function TGoogleLogin.GetLoginError(const str: string): TLoginResult; -var ErrorText:string; +constructor TGoogleLogin.Create(AOwner: TComponent); begin -// - ErrorText:=Trim(copy(str,pos('=',str)+1,Length(str)-pos('=',str))); - Result:=TLoginResult(AnsiIndexStr(ErrorText,Errors)+2); + inherited Create(AOwner); + FAppname := DefaultAppName; // дефолтное значение + //FStatus:=sttNoActive;//неактивен ни один поток end; -function TGoogleLogin.GetResultText: string; +procedure TGoogleLogin.Login(aLoginToken, aLoginCaptcha: string); +var + cBody: TStringStream; + ResponseText: string; begin - case FLastResult of - lrNone: Result:=rcNone; - lrOk: Result:=rcOk; - lrBadAuthentication: Result:=rcBadAuthentication; - lrNotVerified: Result:=rcNotVerified; - lrTermsNotAgreed: Result:=rcTermsNotAgreed; - lrCaptchaRequired: Result:=rcCaptchaRequired; - lrUnknown: Result:=rcUnknown; - lrAccountDeleted: Result:=rcAccountDeleted; - lrAccountDisabled: Result:=rcAccountDisabled; - lrServiceDisabled: Result:=rcServiceDisabled; - lrServiceUnavailable: Result:=rcServiceUnavailable; - end; -end; + cBody := TStringStream.Create(''); + case FAccountType of + atNone, atHOSTED_OR_GOOGLE: + cBody.WriteString('accountType=HOSTED_OR_GOOGLE&'); + atGOOGLE: + cBody.WriteString('accountType=GOOGLE&'); + atHOSTED: + cBody.WriteString('accountType=HOSTED&'); + end; + cBody.WriteString('Email=' + FEmail + '&'); + cBody.WriteString('Passwd=' + URLEncode(FPassword) + '&'); + cBody.WriteString('service=' + GetEnumName(TypeInfo(TServices),Integer(FService)) + '&'); -function TGoogleLogin.Login(aLoginToken, aLoginCaptcha: string): TLoginResult; -var cBody: TStringStream; - ResponseText: string; -begin - // - cBody:=TStringStream.Create(''); - case FAccountType of - atNone,atHOSTED_OR_GOOGLE:cBody.WriteString('accountType=HOSTED_OR_GOOGLE&'); - atGOOGLE:cBody.WriteString('accountType=GOOGLE&'); - atHOSTED:cBody.WriteString('accountType=HOSTED&'); - end; - cBody.WriteString('Email='+FEmail+'&'); - cBody.WriteString('Passwd='+URLEncode(FPassword)+'&'); - cBody.WriteString('service='+ServiceIDs[ord(FService)]+'&'); - - if Length(Trim(FSource))>0 then - cBody.WriteString('source='+FSource) - else - cBody.WriteString('source='+DefaultAppName); - if Length(Trim(aLoginToken))>0 then - begin - cBody.WriteString('&logintoken='+aLoginToken); - cBody.WriteString('&logincaptcha='+aLoginCaptcha); - end; -// -ResponseText:=SendRequest(cBody.DataString); -// -Result:=ExpertLoginResult(ResponseText); -FLastResult:=Result; -if Assigned(FAfterLogin) then - OnAfterLogin(FLastResult,GetResultText) + if Length(Trim(FAppname)) > 0 then + cBody.WriteString('source=' + FAppname) + else + cBody.WriteString('source=' + DefaultAppName); + if (Length(Trim(aLoginToken)) > 0) or (Length(Trim(aLoginCaptcha))>0) then + begin + cBody.WriteString('&logintoken=' + aLoginToken); + cBody.WriteString('&logincaptcha=' + aLoginCaptcha); + end; + // отправляем запрос на сервер + ResponseText := SendRequest(cBody.DataString); end; +// отправляем запрос на сервер в отдельном потоке function TGoogleLogin.SendRequest(const ParamStr: string): AnsiString; - function DataAvailable(hRequest: pointer; out Size : cardinal): boolean; - begin - result := wininet.InternetQueryDataAvailable(hRequest, Size, 0, 0); - end; -var hInternet,hConnect,hRequest : Pointer; - dwBytesRead,I,L : Cardinal; - a:string; begin - a:=ParamStr; -try -hInternet := InternetOpen(PChar('GoogleLogin'),INTERNET_OPEN_TYPE_PRECONFIG,Nil,Nil,0); - if Assigned(hInternet) then - begin - // - hConnect := InternetConnect(hInternet,PChar('www.google.com'),Flags_connection,nil,nil,INTERNET_SERVICE_HTTP,0,1); - if Assigned(hConnect) then - begin - // - hRequest := HttpOpenRequest(hConnect,PChar(uppercase('post')),PChar('accounts/ClientLogin?'+ParamStr),HTTP_VERSION,nil,Nil,Flags_Request,1); - if Assigned(hRequest) then - begin - // - I := 1; - if HttpSendRequest(hRequest,nil,0,nil,0) then - begin - repeat - DataAvailable(hRequest, L);// - - if L = 0 then break; - SetLength(Result,L + I); - if not InternetReadFile(hRequest,@Result[I],sizeof(L),dwBytesRead) then break;// - inc(I,dwBytesRead); - until dwBytesRead = 0; - Result[I] := #0; - end; - end; - end; - end; -finally - InternetCloseHandle(hRequest); - InternetCloseHandle(hConnect); - InternetCloseHandle(hInternet); -end; + FThread := TGoogleLoginThread.Create(true, ParamStr,Self); + FThread.OnAutorization := Self.OnAutorization; + FThread.OnAutorizCaptcha:=Self.OnAutorizCaptcha;//не авторизировались необходимо ввести капчу + FThread.OnProgressAutorization:=Self.OnProgressAutorization;//прогресс авторизации + FThread.OnError := Self.OnError; + FThread.FreeOnTerminate := True; // чтобы сам себя грухнул после окончания операции + FThread.Resume; // запуск + // тут делать смысла что то нет так как данные еще не получены(они ведь будут получены в другом потоке) end; -// , -// , . +// устанавливаем значение строки символов, которая передается серверу +// идентифицирует программное обеспечение, пославшее запрос. procedure TGoogleLogin.SetAppName(value: string); begin - if not (value ='') then - FAppname:=value + if not(value = '') then + FAppname := value else - FAppname:=DefaultAppName; + FAppname := DefaultAppName; end; procedure TGoogleLogin.SetCaptcha(cCaptcha: string); begin - FLogincaptcha:=cCaptcha; - Login(FLogintoken,FLogincaptcha);// + FCaptcha := cCaptcha; + Login(FCapchaToken, FCaptcha); // перелогиниваемся с каптчей end; procedure TGoogleLogin.SetEmail(cEmail: string); begin - FEmail:=cEmail; - if FLastResult=lrOk then - Disconnect;// + FEmail := cEmail; + if FLastResult = lrOk then + Disconnect; // обнуляем результаты end; procedure TGoogleLogin.SetPassword(cPassword: string); begin - FPassword:=cPassword; - if FLastResult=lrOk then - Disconnect;// + FPassword := cPassword; + if FLastResult = lrOk then + Disconnect; // обнуляем результаты end; procedure TGoogleLogin.SetService(cService: TServices); begin - FService:=cService; - if FLastResult=lrOk then - begin - Disconnect;// - Login; // - end; -end; - -procedure TGoogleLogin.SetSource(cSource: string); -begin -FSource:=cSource; -if FLastResult=lrOk then - Disconnect;// + FService := cService; + if FLastResult = lrOk then + begin + Disconnect; // обнуляем результаты + Login; // перелогиниваемся + end; end; function TGoogleLogin.URLDecode(const S: string): string; @@ -410,6 +363,7 @@ function TGoogleLogin.URLDecode(const S: string): string; else Result := Ord(HexChar) - Ord('a') + 10; end; + begin len := 0; n_coded := 0; @@ -418,13 +372,13 @@ function TGoogleLogin.URLDecode(const S: string): string; begin n_coded := n_coded + 1; if n_coded >= 3 then - n_coded := 0; + n_coded := 0; end else begin len := len + 1; if S[i] = '%' then - n_coded := 1; + n_coded := 1; end; SetLength(Result, len); idx := 0; @@ -435,8 +389,8 @@ function TGoogleLogin.URLDecode(const S: string): string; n_coded := n_coded + 1; if n_coded >= 3 then begin - Result[idx] := Chr((WebHexToInt(S[i - 1]) * 16 + - WebHexToInt(S[i])) mod 256); + Result[idx] := Chr((WebHexToInt(S[i - 1]) * 16 + WebHexToInt(S[i])) + mod 256); n_coded := 0; end; end @@ -444,26 +398,26 @@ function TGoogleLogin.URLDecode(const S: string): string; begin idx := idx + 1; if S[i] = '%' then - n_coded := 1; + n_coded := 1; if S[i] = '+' then - Result[idx] := ' ' + Result[idx] := ' ' else - Result[idx] := S[i]; + Result[idx] := S[i]; end; end; { -RUS - URL , - , - - ! -US google translator -URL encoding correct a problem with the fact that if a user password is -special character but now he goes through the authorization correctly -just when you query the server special character is simply discarded -the account login is not checked! + RUS + кодирование URL исправило проблему с тем, что если в пароле пользователя есть + спец символ то теперь, он проходит авторизацию корректно + просто при отправке запроса серверу спец символ просто отбрасывался + на счет логина не проверял! + US google translator + URL encoding correct a problem with the fact that if a user password is + special character but now he goes through the authorization correctly + just when you query the server special character is simply discarded + the account login is not checked! } function TGoogleLogin.URLEncode(const S: string): string; @@ -472,11 +426,10 @@ function TGoogleLogin.URLEncode(const S: string): string; begin len := 0; for i := 1 to Length(S) do - if ((S[i] >= '0') and (S[i] <= '9')) or - ((S[i] >= 'A') and (S[i] <= 'Z')) or - ((S[i] >= 'a') and (S[i] <= 'z')) or (S[i] = ' ') or - (S[i] = '_') or (S[i] = '*') or (S[i] = '-') or (S[i] = '.') then - len := len + 1 + if ((S[i] >= '0') and (S[i] <= '9')) or ((S[i] >= 'A') and (S[i] <= 'Z')) + or ((S[i] >= 'a') and (S[i] <= 'z')) or (S[i] = ' ') or (S[i] = '_') or + (S[i] = '*') or (S[i] = '-') or (S[i] = '.') then + len := len + 1 else len := len + 3; SetLength(Result, len); @@ -488,9 +441,8 @@ function TGoogleLogin.URLEncode(const S: string): string; idx := idx + 1; end else if ((S[i] >= '0') and (S[i] <= '9')) or - ((S[i] >= 'A') and (S[i] <= 'Z')) or - ((S[i] >= 'a') and (S[i] <= 'z')) or - (S[i] = '_') or (S[i] = '*') or (S[i] = '-') or (S[i] = '.') then + ((S[i] >= 'A') and (S[i] <= 'Z')) or ((S[i] >= 'a') and (S[i] <= 'z')) + or (S[i] = '_') or (S[i] = '*') or (S[i] = '-') or (S[i] = '.') then begin Result[idx] := S[i]; idx := idx + 1; @@ -504,4 +456,324 @@ function TGoogleLogin.URLEncode(const S: string): string; end; end; +{ TGoogleLoginThread } + +constructor TGoogleLoginThread.Create(CreateSuspennded: BOOLEAN; aParamStr: string;aParentComp:TComponent); +begin + inherited Create(CreateSuspennded); + FParentComp:=TComponent.Create(nil); + FParentComp:=aParentComp; + FParamStr := aParamStr; + FResultRec.LoginStr := ''; + FResultRec.SID := ''; + FResultRec.LSID := ''; + FResultRec.Auth := ''; + //переменные для прогресса + FProgress:=0; + FMaxProgress:=0; + //изображение капчи + FCaptchaPic:=TPicture.Create; + +end; + +procedure TGoogleLoginThread.Execute; + function DataAvailable(hRequest: pointer; out Size: cardinal): BOOLEAN; + begin + Result := WinInet.InternetQueryDataAvailable(hRequest, Size, 0, 0); + end; + +var + hInternet, hConnect, hRequest: pointer; + dwBytesRead, i, L: cardinal; + sTemp: AnsiString; // текст страницы +begin + try + hInternet := InternetOpen(PChar('GoogleLogin'), + INTERNET_OPEN_TYPE_PRECONFIG, Nil, Nil, 0); + if Assigned(hInternet) then + begin + // Открываем сессию + hConnect := InternetConnect(hInternet, PChar('www.google.com'), + Flags_Connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 1); + if Assigned(hConnect) then + begin + // Формируем запрос + hRequest := HttpOpenRequest(hConnect, PChar(uppercase('post')), + PChar('accounts/ClientLogin?' + FParamStr), HTTP_VERSION, nil, Nil, + Flags_Request, 1); + if Assigned(hRequest) then + begin + // Отправляем запрос + i := 1; + if HttpSendRequest(hRequest, nil, 0, nil, 0) then + begin + repeat + DataAvailable(hRequest, L); // Получаем кол-во принимаемых данных + if L = 0 then + break; + SetLength(sTemp, L + i); + if not InternetReadFile(hRequest, @sTemp[i], sizeof(L),dwBytesRead) then + break; // Получаем данные с сервера + inc(i, dwBytesRead); + if Terminated then // проверка для экстренного закрытия потока + begin + InternetCloseHandle(hRequest); + InternetCloseHandle(hConnect); + InternetCloseHandle(hInternet); + Exit; + end; + FProgress:=i;//текущее значение прогресса авторизации + if FMaxProgress=0 then//зачем постоянно забивать максимальное значение + FMaxProgress:=L+1; + Synchronize(SynProgressAutoriz);//синхронизация прогресса + until dwBytesRead = 0; + sTemp[i] := #0; + end; + end; + end; + end; + except + Synchronize(SynErrAutoriz); + Exit; // сваливаем отсюда + end; + InternetCloseHandle(hRequest); + InternetCloseHandle(hConnect); + InternetCloseHandle(hInternet); + // получаем результаты авторизации + FLastResult := ExpertLoginResult(sTemp); + // текстовый результат авторизации + FResultRec.LoginStr := GetResultText; + //требует ввести капчу + if FLastResult=lrCaptchaRequired then + begin + LoadCaptcha(FCaptchaURL); + Synchronize(SynCaptcha); + end; + FLastResult:=FLastResult; + //если все хорошо, авторизировались + if FLastResult= lrOk then + begin + Synchronize(SynAutoriz); + end; + Synchronize(SynCapchaToken); +end; + +function TGoogleLoginThread.ExpertLoginResult(const LoginResult: string) + : TLoginResult; +var + List: TStringList; + i: Integer; +begin + // грузим ответ сервера в список + List := TStringList.Create; + List.Text := LoginResult; + // анализируем построчно + if pos('error', LowerCase(LoginResult)) > 0 then // есть сообщение об ошибке + begin + for i := 0 to List.Count - 1 do + begin + if pos('error', LowerCase(List[i])) > 0 then // строка с ошибкой + begin + Result := GetLoginError(List[i]); // получили тип ошибки + break; + end; + end; + if Result = lrCaptchaRequired then // требуется ввод каптчи + begin + FCaptchaURL := GetCaptchaURL(List); + FCapthaToken := GetCaptchaToken(List); + end; + end + else + begin + Result := lrOk; + for i := 0 to List.Count - 1 do + begin + if pos('SID', uppercase(List[i])) > 0 then + FResultRec.SID := Trim(copy(List[i], pos('=', List[i]) + 1, + Length(List[i]) - pos('=', List[i]))) + else if pos('LSID', uppercase(List[i])) > 0 then + FResultRec.LSID := Trim(copy(List[i], pos('=', List[i]) + 1, + Length(List[i]) - pos('=', List[i]))) + else if pos('AUTH', uppercase(List[i])) > 0 then + FResultRec.Auth := Trim(copy(List[i], pos('=', List[i]) + 1, + Length(List[i]) - pos('=', List[i]))); + end; + end; + FreeAndNil(List); +end; + +function TGoogleLoginThread.GetCaptchaToken(const cList: TStringList): String; +var + i: Integer; +begin + for i := 0 to cList.Count - 1 do + begin + if pos('captchatoken', LowerCase(cList[i])) > 0 then + begin + Result := Trim(copy(cList[i], pos('=', cList[i]) + 1, + Length(cList[i]) - pos('=', cList[i]))); + break; + end; + end; +end; + +function TGoogleLoginThread.GetCaptchaURL(const cList: TStringList): string; +var + i: Integer; +begin + for i := 0 to cList.Count - 1 do + begin + if pos('captchaurl', LowerCase(cList[i])) > 0 then + begin + Result := Trim(copy(cList[i], pos('=', cList[i]) + 1, + Length(cList[i]) - pos('=', cList[i]))); + break; + end; + end; +end; + +// Если параметр FromServer TRUE, то код ошибки и её текст берется с сервера, в противном случае берется текст локальной ошибки. +function TGoogleLoginThread.GetErrorText(const FromServer: BOOLEAN): string; +var + Msg: array [0 .. 1023] of Char; + ErCode, len: cardinal; +begin + len := sizeof(Msg); + ZeroMemory(@Msg, sizeof(Msg)); + if FromServer then + if InternetGetLastResponseInfo(ErCode, @Msg, len) then + Result := rcErrServer + IntToStr(ErCode) + #13 + StrPas(Msg) + else + Result := rcErrDont + else if FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError, + GetKeyboardLayout(0), @Msg, sizeof(Msg), nil) <> 0 then + Result := StrPas(Msg) + else + Result := rcErrDont; +end; + +function TGoogleLoginThread.GetLoginError(const str: string): TLoginResult; +var + ErrorText: string; +begin + // получили текст ошибки + ErrorText := Trim(copy(str, pos('=', str) + 1, Length(str) - pos('=', str))); + Result := TLoginResult(AnsiIndexStr(ErrorText, Errors) + 2); +end; + +function TGoogleLoginThread.GetResultText: string; +begin + case FLastResult of + lrNone: + Result := rcNone; + lrOk: + Result := rcOk; + lrBadAuthentication: + Result := rcBadAuthentication; + lrNotVerified: + Result := rcNotVerified; + lrTermsNotAgreed: + Result := rcTermsNotAgreed; + lrCaptchaRequired: + Result := rcCaptchaRequired; + lrUnknown: + Result := rcUnknown; + lrAccountDeleted: + Result := rcAccountDeleted; + lrAccountDisabled: + Result := rcAccountDisabled; + lrServiceDisabled: + Result := rcServiceDisabled; + lrServiceUnavailable: + Result := rcServiceUnavailable; + end; +end; + +//загрузка капчи +function TGoogleLoginThread.LoadCaptcha(aCaptchaURL: string): Boolean; + function DataAvailable(hRequest: pointer; out Size: cardinal): BOOLEAN; + begin + Result := WinInet.InternetQueryDataAvailable(hRequest, Size, 0, 0); + end; +var + hInternet, hConnect,hRequest: pointer; + dwBytesRead, i, L: cardinal; + sTemp: AnsiString; // текст страницы + memStream: TMemoryStream; + jpegimg: TJPEGImage; + url:string; +begin + Result:=False;; + url:='http://www.google.com/accounts/'+aCaptchaURL; + hInternet := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); + try + if Assigned(hInternet) then + begin + hConnect := InternetOpenUrl(hInternet, PChar(url), nil, 0, 0, 0); + if Assigned(hConnect) then + try + i := 1; + repeat + SetLength(sTemp, L + i); + if not InternetReadFile(hConnect, @sTemp[i], sizeof(L),dwBytesRead) then + break; // Получаем данные с сервера + inc(i, dwBytesRead); + until dwBytesRead = 0; + //sTemp[i] := #0; + finally + InternetCloseHandle(hConnect); + end; + end; + finally + InternetCloseHandle(hInternet); + end; + memStream := TMemoryStream.Create; + jpegimg := TJPEGImage.Create; + try + memStream.Write(sTemp[1], Length(sTemp)); + memStream.Position := 0; + //загрузка изображения из потока + jpegimg.LoadFromStream(memStream); + FCaptchaPic.Assign(jpegimg); + finally + //очистка + memStream.Free; + jpegimg.Free; + end; + Result:=True; +end; + +procedure TGoogleLoginThread.SynAutoriz; +begin + if Assigned(FAutorization) then + OnAutorization(FLastResult, FResultRec); +end; + +//необходимо ввести капчу +procedure TGoogleLoginThread.SynCapchaToken; +begin + if Assigned(FParentComp) then + TGoogleLogin(FParentComp).FCapchaToken:=Self.FCapthaToken; +end; + +procedure TGoogleLoginThread.SynCaptcha; +begin + if Assigned(FAutorizCaptcha) then + OnAutorizCaptcha(FCaptchaPic); +end; + +procedure TGoogleLoginThread.SynErrAutoriz; +begin + if Assigned(FErrorAutorization) then + OnError(GetErrorText(true)); // получаем текст ошибки +end; + + +procedure TGoogleLoginThread.SynProgressAutoriz; +begin + if Assigned(FProgressAutorization) then + OnProgressAutorization(FProgress,FMaxProgress); // передаем прогресс авторизации +end; + end. diff --git a/source/GData.pas b/source/GData.pas index 0861f3e..ca6ed76 100644 --- a/source/GData.pas +++ b/source/GData.pas @@ -1,4 +1,5 @@ <<<<<<< HEAD +<<<<<<< HEAD unit GData; interface @@ -511,6 +512,8 @@ procedure TGDElemntList.SetRecord(index: Integer; Ptr: PGDElement); end. ======= +======= +>>>>>>> remotes/origin/NMD unit GData; interface @@ -1022,4 +1025,520 @@ procedure TGDElemntList.SetRecord(index: Integer; Ptr: PGDElement); end; end. +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD +======= +======= +unit GData; + +interface + +uses strutils, GHelper, XMLIntf,SysUtils, Variants, Classes, + StdCtrls, XMLDoc, xmldom, GDataCommon; + +// +type + TAuthorElement = record + Email: string; + Name: string; + end; + +type + TLinkElement = record + rel: string; + typ: string; + href: string; + end; + +type + PLinkElement = ^TLinkElement; + +type + TLinkElementList = class(TList) + private + procedure SetRecord(index: Integer; Ptr: PLinkElement); + function GetRecord(index: Integer): PLinkElement; + public + constructor Create; + procedure Clear; + destructor Destroy; override; + property LinkElement[i: Integer] + : PLinkElement read GetRecord write SetRecord; + end; + +type + TGeneratorElement = record + varsion: string; + uri: string; + name: string; + end; + +type + TCategoryElement = record + scheme: string; + term: string; + clabel: string; + end; + +type + TCommonElements = array of IXMLNode; + +type + TGDElement = record + ElementType : TgdEnum; + XMLNode: IXMLNode; +end; + +type + PGDElement = ^TGDElement; + +type + TGDElemntList = class(TList) + private + procedure SetRecord(index: Integer; Ptr: PGDElement); + function GetRecord(index: Integer): PGDElement; + public + constructor Create; + procedure Clear; + destructor Destroy; override; + property GDElement[i: Integer]: PGDElement read GetRecord write SetRecord; + +end; + +type + TEntryElement = class + private + FXMLNode: IXMLNode; + FTerm: TEntryTerms; + FEtag: string; + FId: string; + FTitle: string; + FSummary: string; + FContent: string; + FAuthor: TAuthorElement; + FCategory: TCategoryElement; + FPublicationDate: TDateTime; + FUpdateDate: TDateTime; + FLinks: TLinkElementList; + FCommonElements: TCommonElements; + FGDElemntList:TGDElemntList; + procedure GetBasicElements; + function GetNodeName(aElementName: TgdEnum): string; + procedure GetGDList; + function GetEntryTerm: TEntryTerms; + public + constructor Create(aXMLNode: IXMLNode); + function FindGDElement(aElementName: TgdEnum; var resNode: IXMLNode) + : boolean; + property ETag: string read FEtag; + property ID: string read FId; + property Title: string read FTitle; + property Summary: string read FSummary; + property Content: string read FContent; + property Author: TAuthorElement read FAuthor; + property Category: TCategoryElement read FCategory; + property Publication: TDateTime read FPublicationDate; + property Update: TDateTime read FUpdateDate; + property Links: TLinkElementList read FLinks; + property CommonElements: TCommonElements read FCommonElements; + property GDElemntList:TGDElemntList read FGDElemntList; + property Term: TEntryTerms read GetEntryTerm; + end; + + + + +implementation + + + +{ TLinkElementList } + +procedure TLinkElementList.Clear; +var + i: Integer; + p: PLinkElement; +begin + for i := 0 to Pred(Count) do + begin + p := LinkElement[i]; + if p <> nil then + Dispose(p); + end; + inherited Clear; +end; + +constructor TLinkElementList.Create; +begin + inherited Create; +end; + +destructor TLinkElementList.Destroy; +begin + Clear; + inherited Destroy; + +end; + +function TLinkElementList.GetRecord(index: Integer): PLinkElement; +begin + Result := PLinkElement(Items[index]); +end; + +procedure TLinkElementList.SetRecord(index: Integer; Ptr: PLinkElement); +var + p: PLinkElement; +begin + p := LinkElement[index]; + if p <> Ptr then + begin + if p <> nil then + Dispose(p); + Items[index] := Ptr; + end; +end; + +{ TEntryElemet } + +constructor TEntryElement.Create(aXMLNode: IXMLNode); +var + i: TgdEnum; +begin + if aXMLNode = nil then + Exit; + FXMLNode := aXMLNode; + FLinks := TLinkElementList.Create; + FGDElemntList:=TGDElemntList.Create; + GetBasicElements; + GetGDList; +end; + +function TEntryElement.FindGDElement(aElementName: TgdEnum; + var resNode: IXMLNode): boolean; +var + FindName: string; + i: Integer; + iNode: IXMLNode; + + procedure ProcessNode(Node: IXMLNode); + var + cNode: IXMLNode; + begin + if Node = nil then + Exit; + if LowerCase(FCommonElements[i].NodeName) = LowerCase(FindName) then + begin + resNode := FCommonElements[i]; + Exit; + end + else + begin + cNode := Node.ChildNodes.First; + while cNode <> nil do + begin + ProcessNode(cNode); + cNode := cNode.NextSibling; + end; + end; + end; + +begin + resNode := nil; + FindName := GetNodeName(aElementName); + i := 0; + iNode := FCommonElements[0]; // + while (i > Length(FCommonElements)) or (resNode = nil) do + begin + ProcessNode(iNode); // + i := i + 1; + iNode := FCommonElements[i]; + end; +end; + +procedure TEntryElement.GetBasicElements; +var + i: Integer; + LinkElement: PLinkElement; +begin + if FXMLNode.Attributes['gd:etag'] <> null then + FEtag := FXMLNode.Attributes['gd:etag']; + for i := 0 to FXMLNode.ChildNodes.Count - 1 do + begin + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'id' then + FId := FXMLNode.ChildNodes[i].Text + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'published' then + FPublicationDate := ServerDateToDateTime(FXMLNode.ChildNodes[i].Text) + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'updated' then + FUpdateDate := ServerDateToDateTime(FXMLNode.ChildNodes[i].Text) + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'category' then + begin + if FXMLNode.ChildNodes[i].Attributes['scheme'] <> null then + FCategory.scheme := FXMLNode.ChildNodes[i].Attributes['scheme']; + if FXMLNode.ChildNodes[i].Attributes['term'] <> null then + FCategory.term := FXMLNode.ChildNodes[i].Attributes['term']; + end + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'title' then + FTitle := FXMLNode.ChildNodes[i].Text + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'content' then + FContent := FXMLNode.ChildNodes[i].Text + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'link' then + begin + New(LinkElement); + with LinkElement^ do + begin + if FXMLNode.ChildNodes[i].Attributes['rel'] <> null then + rel := FXMLNode.ChildNodes[i].Attributes['rel']; + if FXMLNode.ChildNodes[i].Attributes['type'] <> null then + typ := FXMLNode.ChildNodes[i].Attributes['type']; + if FXMLNode.ChildNodes[i].Attributes['href'] <> null then + href := FXMLNode.ChildNodes[i].Attributes['href']; + end; + FLinks.Add(LinkElement); + end + else + if LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'author' then + begin + if FXMLNode.ChildNodes[i].ChildNodes.FindNode('name') + <> nil then + FAuthor.Name := FXMLNode.ChildNodes[i].ChildNodes.FindNode + ('name').Text; + if FXMLNode.ChildNodes[i].ChildNodes.FindNode('email') + <> nil then + FAuthor.Name := FXMLNode.ChildNodes[i].ChildNodes.FindNode + ('email').Text; + end + else + if (LowerCase(FXMLNode.ChildNodes[i].NodeName) + = 'description') or + (LowerCase(FXMLNode.ChildNodes[i].NodeName) = 'summary') + then + FSummary := FXMLNode.ChildNodes[i].Text + else + begin + SetLength(FCommonElements, Length(FCommonElements) + 1); + FCommonElements[Length(FCommonElements) - 1] := + FXMLNode.ChildNodes[i]; + end; + end; +end; + +function TEntryElement.GetEntryTerm: TEntryTerms; +var + TermStr: string; +begin + FTerm := ttAny; + if Length(FCategory.term) = 0 then + Exit; + TermStr := copy(FCategory.term, pos('#', FCategory.term) + 1, Length + (FCategory.term) - pos('#', FCategory.term)); + if LowerCase(TermStr) = 'contact' then + Result := ttContact + else + if LowerCase(TermStr) = 'event' then + Result := ttEvent + else + if LowerCase(TermStr) = 'message' then + Result := ttMessage + else + if LowerCase(TermStr) = 'type' then + Result := ttType +end; + +procedure TEntryElement.GetGDList; +var + i: Integer; + iNode: IXMLNode; + + procedure ProcessNode(Node: IXMLNode); + var + cNode: IXMLNode; + Index: integer; + NodeType: TgdEnum; + GDElemet: PGDElement; + begin + if (Node = nil)or(pos('gd:',Node.NodeName)<=0) then Exit; + Index:=ord(GetGDNodeType(Node.NodeName)); + if index>-1 then + begin + NodeType:=TgdEnum(index); + New(GDElemet); + with GDElemet^ do + begin + ElementType:=NodeType; + XMLNode:=Node; + end; + FGDElemntList.Add(GDElemet); + // ShowMessage(IntToStr(FGDElemntList.Count)); + end; + + cNode := Node.ChildNodes.First; + while cNode <> nil do + begin + ProcessNode(cNode); + cNode := cNode.NextSibling; + end; + end; + +begin +// i:=0; +// iNode := FCommonElements[0]; // + for I := 0 to Length(FCommonElements) - 1 do + begin + iNode:=FCommonElements[i]; + ProcessNode(iNode); // + end; + +end; + +function TEntryElement.GetNodeName(aElementName: TgdEnum): string; +begin +Result:=GetGDNodeName(aElementName); +// case aElementName of +// gdCountry: +// Result := 'gd:country'; +// gdAdditionalName: +// Result := 'gd:additionalName'; +// gdName: +// Result := 'gd:country'; +// gdEmail: +// Result := 'gd:email'; +// gdExtendedProperty: +// Result := 'gd:extendedProperty'; +// gdGeoPt: +// Result := 'gd:geoPt'; +// gdIm: +// Result := 'gd:im'; +// gdOrgName: +// Result := 'gd:orgName'; +// gdOrgTitle: +// Result := 'gd:orgTitle'; +// gdOrganization: +// Result := 'gd:organization'; +// gdOriginalEvent: +// Result := 'gd:originalEvent'; +// gdPhoneNumber: +// Result := 'gd:phoneNumber'; +// gdPostalAddress: +// Result := 'gd:postalAddress'; +// gdRating: +// Result := 'gd:rating'; +// gdRecurrence: +// Result := 'gd:recurrence'; +// gdReminder: +// Result := 'gd:reminder'; +// gdResourceId: +// Result := 'gd:resourceId'; +// gdWhen: +// Result := 'gd:when'; +// gdAgent: +// Result := 'gd:agent'; +// gdHousename: +// Result := 'gd:housename'; +// gdStreet: +// Result := 'gd:street'; +// gdPobox: +// Result := 'gd:pobox'; +// gdNeighborhood: +// Result := 'gd:neighborhood'; +// gdCity: +// Result := 'gd:city'; +// gdSubregion: +// Result := 'gd:subregion'; +// gdRegion: +// Result := 'gd:region'; +// gdPostcode: +// Result := 'gd:postcode'; +// gdFormattedAddress: +// Result := 'gd:formattedaddress'; +// gdStructuredPostalAddress: +// Result := 'gd:structuredPostalAddress'; +// gdEntryLink: +// Result := 'gd:entryLink'; +// gdWhere: +// Result := 'gd:where'; +// gdFamilyName: +// Result := 'gd:familyName'; +// gdGivenName: +// Result := 'gd:givenName'; +// gdFamileName: +// Result := 'gd:FamileName'; +// gdNamePrefix: +// Result := 'gd:namePrefix'; +// gdNameSuffix: +// Result := 'gd:nameSuffix'; +// gdFullName: +// Result := 'gd:fullName'; +// gdOrgDepartment: +// Result := 'gd:orgDepartment'; +// gdOrgJobDescription: +// Result := 'gd:orgJobDescription'; +// gdOrgSymbol: +// Result := 'gd:orgSymbol'; +// gdEventStatus: +// Result := 'gd:eventStatus'; +// gdVisibility: +// Result := 'gd:visibility'; +// gdTransparency: +// Result := 'gd:transparency'; +// gdAttendeeType: +// Result := 'gd:attendeeType'; +// gdAttendeeStatus: +// Result := 'gd:attendeeStatus'; +// end; +end; + +{ GDElemntList } + +procedure TGDElemntList.Clear; +var + i: Integer; + p: PGDElement; +begin + for i := 0 to Pred(Count) do + begin + p := GDElement[i]; + if p <> nil then + Dispose(p); + end; + inherited Clear; +end; + + +constructor TGDElemntList.Create; +begin + inherited Create; +end; + +destructor TGDElemntList.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TGDElemntList.GetRecord(index: Integer): PGDElement; +begin + Result:= PGDElement(Items[index]); +end; + +procedure TGDElemntList.SetRecord(index: Integer; Ptr: PGDElement); +var + p: PGDElement; +begin + p := GDElement[index]; + if p <> Ptr then + begin + if p <> nil then + Dispose(p); + Items[index] := Ptr; + end; +end; + +end. +>>>>>>> remotes/origin/Vlad55 >>>>>>> remotes/origin/NMD diff --git a/source/GDataCommon.pas b/source/GDataCommon.pas index 9806f8e..e43fdf2 100644 --- a/source/GDataCommon.pas +++ b/source/GDataCommon.pas @@ -1,3 +1,4 @@ +<<<<<<< HEAD { Модуль содержит наиболее общие классы для работы с Google API, а также классы и методы для работы с основой всех API - GData API. Этот содуль должен подключаться в раздел uses всех прочих модулей, реализующих работу @@ -2456,6 +2457,9 @@ procedure TgdExtendedProperty.ParseXML(const Node: TXMLNode); end. ======= +======= +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD unit GDataCommon; { TODO : , } interface @@ -3981,4 +3985,1811 @@ procedure TgdIm.ParseXML(const Node: TXmlNode); end; end. +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD +======= +======= +unit GDataCommon; + +interface + +uses NativeXML, Classes, StrUtils, SysUtils, GHelper, typinfo, uLanguage; + +type + TgdEnum = (gd_country, gd_additionalName,gd_name, gd_email, gd_extendedProperty, + gd_geoPt, gd_im,gd_orgName, gd_orgTitle, gd_organization, gd_originalEvent, + gd_phoneNumber, gd_postalAddress, gd_rating, gd_recurrence,gd_reminder, + gd_resourceId, gd_when, gd_agent, gd_housename, gd_street, gd_pobox, + gd_neighborhood, gd_city, gd_subregion,gd_region, gd_postcode,gd_formattedAddress, + gd_structuredPostalAddress, gd_entryLink, gd_where, gd_familyName, + gd_givenName, gd_namePrefix, gd_nameSuffix,gd_fullName, gd_orgDepartment, + gd_orgJobDescription, gd_orgSymbol, gd_famileName, gd_eventStatus, + gd_visibility, gd_transparency, gd_attendeeType, gd_attendeeStatus, + gd_comments, gd_deleted,gd_feedLink, gd_who, gd_recurrenceException); + +type + TGDataTags = set of TgdEnum; + +type + TEventStatus = (esCanceled, esConfirmed, esTentative); + TgdEventStatus = class + private + FValue: string; + FStatus: TEventStatus; + const + RelValues: array [0..2]of string=( + 'event.canceled','event.confirmed','event.tentative'); + procedure SetStatus(aStatus:TEventStatus); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty: boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Status:TEventStatus read FStatus write SetStatus; + end; + +type + TVisibility = (vConfidential, vDefault, vPrivate, vPublic); + TgdVisibility = class + private + FValue: string; + FVisible: TVisibility; + const + RelValues: array [0..3]of string = ( + 'event.confidential','event.default','event.private','event.public'); + procedure SetVisible(aVisible:TVisibility); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty:boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Visibility: TVisibility read FVisible write SetVisible; + end; + +type + TTransparency = (tOpaque, tTransparent); + TgdTransparency = class(TPersistent) + private + FValue: string; + FTransparency: TTransparency; + const + RelValues: array [0 .. 1] of string = ('event.opaque','event.transparent'); +// procedure SetValue(aValue:string); + procedure SetTransp(aTransp:TTransparency); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty:boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; +// property Value: string read FValue write SetValue; + property Transparency: TTransparency read FTransparency write SetTransp; + end; + +type + TAttendeeType = (aOptional, aRequired); + TgdAttendeeType = class + private + FValue: string; + FAttType: TAttendeeType; + const RelValues: array [0 .. 1] of string = + ('event.optional','event.required'); +// procedure SetValue(aValue:string); + procedure SetType(aStatus:TAttendeeType); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty:boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; +// property Value: string read FValue write SetValue; + property AttendeeType: TAttendeeType read FAttType write SetType; + end; + +type + TAttendeeStatus = (asAccepted, asDeclined, asInvited, asTentative); + TgdAttendeeStatus = class + private + FValue: string; + FAttendeeStatus: TAttendeeStatus; + const + RelValues: array [0 .. 3] of string = ( + 'event.accepted','event.declined','event.invited','event.tentative'); + // procedure SetValue(aValue:string); + procedure SetStatus(aStatus:TAttendeeStatus); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function isEmpty: boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; +// property Value: string read FValue write SetValue; + property Status: TAttendeeStatus read FAttendeeStatus write SetStatus; + end; + +type + TEntryTerms = (ttAny, ttContact, ttEvent, ttMessage, ttType); + +type + TgdCountry = class(TPersistent) + private + FCode: string; + FValue: string; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty: boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Code: string read FCode write FCode; + property Value: string read FValue write FValue; + end; + +type + TgdAdditionalName = TTextTag; + TgdFamilyName = TTextTag; + TgdGivenName = TTextTag; + TgdNamePrefix = TTextTag; + TgdNameSuffix = TTextTag; + TgdFullName = TTextTag; + TgdOrgDepartment = TTextTag; + TgdOrgJobDescription = TTextTag; + TgdOrgSymbol = TTextTag; + +type + TgdName = class + private + FGivenName: TTextTag; + FAdditionalName: TTextTag; + FFamilyName: TTextTag; + FNamePrefix: TTextTag; + FNameSuffix: TTextTag; + FFullName: TTextTag; + function GetFullName:string; + procedure SetFullName(aFullName: TTextTag); + procedure SetGivenName(aGivenName: TTextTag); + procedure SetAdditionalName(aAdditionalName: TTextTag); + procedure SetFamilyName(aFamilyName: TTextTag); + procedure SetNamePrefix(aNamePrefix: TTextTag); + procedure SetNameSuffix(aNameSuffix: TTextTag); + public + constructor Create(ByNode: TXMLNode=nil); + procedure ParseXML(const Node: TXmlNode); + procedure Clear; + function IsEmpty:boolean; + function AddToXML(Root:TXMLNode):TXmlNode; + property GivenName: TTextTag read FGivenName write SetGivenName; + property AdditionalName: TTextTag read FAdditionalName write SetAdditionalName; + property FamilyName: TTextTag read FFamilyName write SetFamilyName; + property NamePrefix: TTextTag read FNamePrefix write SetNamePrefix; + property NameSuffix: TTextTag read FNameSuffix write FNameSuffix; + property FullName: TTextTag read FFullName write SetFullName; + property FullNameString: string read GetFullName; +end; + +type + TTypeElement = (ttHome,ttOther, ttWork); + TgdEmail = class(TPersistent) + private + FAddress: string; + FEmailType: TTypeElement; + FLabel: string; + FRel: string; + FPrimary: boolean; + FDisplayName:string; + const RelValues: array[0..2]of string=('home','other','work'); + procedure SetRel(const aRel:string); + procedure SetEmailType(aType:TTypeElement); + public + constructor Create(ByNode: TXMLNode=nil); + procedure Clear; + function IsEmpty:boolean; + procedure ParseXML(const Node: TXmlNode); + function AddToXML(Root:TXMLNode):TXmlNode; + property Address : string read FAddress write FAddress; + property Labl:string read FLabel write FLabel; + property Rel: string read FRel write SetRel; + property DisplayName: string read FDisplayName write FDisplayName; + property Primary: boolean read FPrimary write FPrimary; + property EmailType:TTypeElement read FEmailType write SetEmailType; + end; + +type + TgdExtendedPropertyStruct = record + Name: string; + Value: string; + end; + +type + TgdGeoPtStruct = record + Elav: extended; + Labels: string; + Lat: extended; + Lon: extended; + Time: TDateTime; + end; + +type + TIMProtocol = (tiAIM,tiMSN,tiYAHOO,tiSKYPE,tiQQ,tiGOOGLE_TALK,tiICQ,tiJABBER); + TIMtype = (timHome,timNetmeeting,timOther,timWork); + +type + TgdIm = class(TPersistent) + private + FAddress: string; + FLabel: string; + FPrimary: boolean; + FIMProtocol:TIMProtocol; + FIMType:TIMtype; + const + RelValues: array[0..3]of string=('home','netmeeting','other','work'); + ProtocolValues:array[0..7]of string=('AIM','MSN','YAHOO','SKYPE','QQ','GOOGLE_TALK','ICQ','JABBER'); + public + constructor Create(ByNode: TXMLNode=nil); + procedure ParseXML(const Node: TXmlNode); + procedure Clear; + function IsEmpty: boolean; + function AddToXML(Root:TXMLNode):TXmlNode; + property Address: string read FAddress write FAddress; + property iLabel: string read FLabel write FLabel; + property ImType: TIMtype read FIMType write FIMType; + property Protocol: TIMProtocol read FIMProtocol write FIMProtocol; + property Primary: boolean read FPrimary write FPrimary; +end; + + TgdOrgName = TTextTag; + TgdOrgTitle = TTextTag; + +type + TgdOrganization = class(TPersistent) + private + FLabel: string; + Frel: string; + Fprimary: boolean; + ForgName: TgdOrgName; + ForgTitle: TgdOrgTitle; + public + constructor Create(ByNode: TXMLNode=nil); + procedure ParseXML(const Node: TXmlNode); + function AddToXML(Root:TXMLNode):TXmlNode; + function IsEmpty:boolean; + procedure Clear; + property Labl: string read FLabel write FLabel; + property Rel: string Read FRel write FRel; + property Primary: boolean read Fprimary write Fprimary; + property OrgName: TgdOrgName read ForgName write ForgName; + property OrgTitle: TgdOrgTitle read ForgTitle write ForgTitle; +end; + +type + TgdOriginalEventStruct = record + id: string; + href: string; + end; + +type + TPhonesRel=(tpAssistant,tpCallback,tpCar,TpCompany_main,tpFax, + tpHome,tpHome_fax,tpIsdn,tpMain,tpMobile,tpOther,tpOther_fax, + tpPager,tpRadio,tpTelex,tpTty_tdd,TpWork,tpWork_fax, + tpWork_mobile,tpWork_pager); + TgdPhoneNumber = class + private { DONE -o -c : FRel - } + FPrimary: boolean; + FPhoneType: TPhonesRel; + FLabel: string; + // Frel: string; + FUri: string; + FValue: string; + const RelValues: array[0..19]of string=('assistant','callback','car','company_main','fax', + 'home','home_fax','isdn','main','mobile','other','other_fax','pager', + 'radio','telex','tty_tdd','work','work_fax','work_mobile','work_pager'); + // procedure SetRel(aPhoneRel:TPhonesRel); + public + constructor Create(ByNode: TXMLNode=nil); + function IsEmpty: boolean; + procedure Clear; + procedure ParseXML(const Node: TXmlNode); + function AddToXML(Root:TXMLNode):TXmlNode; + property PhoneType: TPhonesRel read FPhoneType write FPhoneType; + property Primary: boolean read FPrimary write FPrimary; + property Labl: string read FLabel write FLabel; +// property Rel: string read Frel write Frel; + property Uri: string read FUri write FUri; + property Text: string read FValue write FValue; + end; + +type + TgdPostalAddressStruct = record + Labels: string; + rel: string; + primary: boolean; + Text: string; + end; + +type + TgdRatingStruct = record + Average: extended; + Max: integer; + Min: integer; + numRaters: integer; + rel: string; + Value: integer; + end; + +type + TgdRecurrence = class + private + FText: TStringList; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty: boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Text: TStringList read FText write FText; +end; + + +{ TODO -oVlad -cBug : : " " . } +const + cMethods : array [0..2]of string =('alert','email','sms'); +type + TMethod = (tmAlert, tmEmail, tmSMS); + TRemindPeriod = (tpDays, tpHours, tpMinutes); + +type + TgdReminder = class (TPersistent) + private + FabsoluteTime: TDateTime; + Fmethod: TMethod; + FPeriod: TRemindPeriod; + FPeriodValue: integer; + public + Constructor Create(const ByNode:TXMLNode); + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property AbsTime: TDateTime read FabsoluteTime write FabsoluteTime; + property Method: TMethod read Fmethod write Fmethod; + property Period: TRemindPeriod read FPeriod write FPeriod; + property PeriodValue:integer read FPeriodValue write FPeriodValue; + end; + +type + TgdResourceIdStruct = string; + +type + TDateFormat = (tdDate, tdServerDate); + TgdWhen = class + private + FendTime: TDateTime; + FstartTime: TDateTime; + FvalueString: string; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function isEmpty:boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode;DateFormat:TDateFormat):TXMLNode; + property endTime: TDateTime read FendTime write FendTime; + property startTime: TDateTime read FstartTime write FstartTime; + property valueString: string read FvalueString write FvalueString; + end; + +type + TgdAgent = TTextTag; + TgdHousename = TTextTag; + TgdStreet = TTextTag; + TgdPobox = TTextTag; + TgdNeighborhood = TTextTag; + TgdCity = TTextTag; + TgdSubregion = TTextTag; + TgdRegion = TTextTag; + TgdPostcode = TTextTag; + TgdFormattedAddress = TTextTag; + +type + TgdStructuredPostalAddress = class + private + FRel: string; + FMailClass: string; + FUsage: string; + Flabel: string; + Fprimary: boolean; + FAgent: TgdAgent; + FHouseName: TgdHousename; + FStreet: TgdStreet; + FPobox: TgdPobox; + FNeighborhood: TgdNeighborhood; + FCity: TgdCity; + FSubregion: TgdSubregion; + FRegion: TgdRegion; + FPostcode: TgdPostcode; + FCountry: TgdCountry; + FFormattedAddress: TgdFormattedAddress; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + function IsEmpty: boolean; + property Rel: string read FRel write FRel; + property MailClass: string read FMailClass write FMailClass; + property Usage: string read FUsage write FUsage; + property Labl: string read Flabel write Flabel; + property Primary: boolean read FPrimary write FPrimary; + property Agent: TgdAgent read FAgent write FAgent; + property HouseName: TgdHousename read FHouseName write FHouseName; + property Street: TgdStreet read FStreet write FStreet; + property Pobox: TgdPobox read FPobox write FPobox; + property Neighborhood: TgdNeighborhood read FNeighborhood write FNeighborhood; + property City: TgdCity read FCity write FCity; + property Subregion: TgdSubregion read FSubregion write FSubregion; + property Region: TgdRegion read FRegion write FRegion; + property Postcode: TgdPostcode read FPostcode write FPostcode; + property Coutry: TgdCountry read FCountry write FCountry; + property FormattedAddress: TgdFormattedAddress read FFormattedAddress write FFormattedAddress; + end; + +type + TgdEntryLink = class + private + Fhref: string; + FReadOnly: boolean; + Frel: string; + FAtomEntry: TXMLNode; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure ParseXML(Node: TXMLNode); + procedure Clear; + function IsEmpty:boolean; + function AddToXML(Root:TXMLNode):TXMLNode; + property Href: string read Fhref write Fhref; + property OnlyRead: boolean read FReadOnly write FReadOnly; + property Rel: string read Frel write Frel; + end; + +type + TgdWhere = class + private + Flabel: string; + Frel: string; + FvalueString: string; + FEntryLink: TgdEntryLink; + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty: boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Labl:string read Flabel write Flabel; + property Rel:string read FRel write FRel; + property valueString: string read FvalueString write FvalueString; + property EntryLink: TgdEntryLink read FEntryLink write FEntryLink; + end; + +type + TWhoRel = (twAttendee,twOrganizer,twPerformer,twSpeaker,twBcc,twCc,twFrom,twReply,twTo); + TgdWho = class(TPersistent) + private + FEmail: string; + Frel: string; + FRelValue: TWhoRel; + FvalueString: string; + FAttendeeStatus: TgdAttendeeStatus; + FAttendeeType: TgdAttendeeType; + FEntryLink: TgdEntryLink; + const + RelValues: array [0..8] of string = ( + 'event.attendee','event.organizer','event.performer','event.speaker', + 'message.bcc','message.cc','message.from','message.reply-to','message.to'); +// procedure SetRel(aRel:string); +// procedure SetRelValue(aRelValue:TWhoRel); + public + Constructor Create(const ByNode:TXMLNode=nil); + procedure Clear; + function IsEmpty:boolean; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root:TXMLNode):TXMLNode; + property Email: string read FEmail write FEmail; +// property Rel: string read Frel write SetRel; + property RelValue: TWhoRel read FRelValue write FRelValue; + property valueString: string read FvalueString write FvalueString; + property AttendeeStatus: TgdAttendeeStatus read FAttendeeStatus write FAttendeeStatus; + property AttendeeType: TgdAttendeeType read FAttendeeType write FAttendeeType; + property EntryLink: TgdEntryLink read FEntryLink write FEntryLink; +end; + +function GetGDNodeType(cName: string): TgdEnum; +function GetGDNodeName(NodeType:TgdEnum):string;inline; + +function gdAttendeeStatus(aXMLNode: TXMLNode): TgdAttendeeStatus; +function gdAttendeeType(aXMLNode: TXMLNode): TgdAttendeeType; +function gdTransparency(aXMLNode: TXMLNode): TgdTransparency; +function gdVisibility(aXMLNode: TXMLNode): TgdVisibility; +function gdEventStatus(aXMLNode: TXMLNode): TgdEventStatus; +function gdWhere(aXMLNode: TXMLNode):TgdWhere; +function gdWhen(aXMLNode: TXMLNode):TgdWhen; +function gdWho(aXMLNode: TXMLNode):TgdWho; +function gdRecurrence(aXMLNode: TXMLNode):TgdRecurrence; +function gdReminder(aXMLNode: TXMLNode):TgdReminder; + +implementation + +function GetGDNodeName(NodeType:TgdEnum):string;inline; +begin + Result:=StringReplace(GetEnumName(TypeInfo(TgdEnum),ord(NodeType)), + '_',':',[rfReplaceAll]); +end; + +function gdReminder(aXMLNode: TXMLNode):TgdReminder; +begin + Result:=TgdReminder.Create(aXMLNode); +end; + +function gdRecurrence(aXMLNode: TXMLNode):TgdRecurrence; +begin + Result:=TgdRecurrence.Create(aXMLNode); +end; + +function gdWho(aXMLNode: TXMLNode):TgdWho; +begin + Result:=TgdWho.Create(aXMLNode); +end; + +function gdWhen(aXMLNode: TXMLNode):TgdWhen; +begin + Result:=TgdWhen.Create(aXMLNode); +end; + +function gdWhere(aXMLNode: TXMLNode):TgdWhere; +begin + Result:=TgdWhere.Create(aXMLNode); +end; + +function gdEventStatus(aXMLNode: TXMLNode): TgdEventStatus; +begin + Result:=TgdEventStatus.Create(aXMLNode); +end; + +function gdVisibility(aXMLNode: TXMLNode): TgdVisibility; +begin + Result:=TgdVisibility.Create(aXMLNode); +end; + +function gdTransparency(aXMLNode: TXMLNode): TgdTransparency; +begin + Result:=TgdTransparency.Create(aXMLNode); +end; + +function GetGDNodeType(cName: string): TgdEnum; +begin + Result :=TgdEnum(GetEnumValue(TypeInfo(TgdEnum),ReplaceStr(cName,':','_'))); +end; + +function gdAttendeeType(aXMLNode: TXMLNode): TgdAttendeeType; +begin + Result:=TgdAttendeeType.Create(aXMLNode); +end; + +function gdAttendeeStatus(aXMLNode: TXMLNode): TgdAttendeeStatus; +begin + Result:=TgdAttendeeStatus.Create(aXMLNode); +end; + +{ TgdWhere } + +function TgdWhere.AddToXML(Root: TXMLNode): TXMLNode; +begin + // + if Root=nil then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_where)); + if Length(Flabel)>0 then + Result.WriteAttributeString('label',Flabel); + if Length(Frel)>0 then + Result.WriteAttributeString('rel',Frel); + if Length(FvalueString)>0 then + Result.WriteAttributeString('valueString',FvalueString); + if FEntryLink<>nil then + if (FEntryLink.FAtomEntry<>nil)or(Length(FEntryLink.Fhref)>0) then + FEntryLink.AddToXML(Result); +end; + +procedure TgdWhere.Clear; +begin + Flabel:=''; + Frel:=''; + FvalueString:=''; +end; + +constructor TgdWhere.Create(const ByNode: TXMLNode); +begin +inherited Create; +Clear; +if ByNode=nil then Exit; +FEntryLink:=TgdEntryLink.Create(nil); +ParseXML(ByNode); +end; + +function TgdWhere.IsEmpty: boolean; +begin + Result:=(Length(Trim(Flabel))=0)and(Length(Trim(Frel))=0)and(Length(Trim(FvalueString))=0) +end; + +procedure TgdWhere.ParseXML(Node: TXMLNode); +begin +if GetGDNodeType(Node.Name) <> gd_Where then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Where)])); + try + Flabel:=Node.ReadAttributeString('label'); + if Length(FLabel)=0 then + Flabel:=Node.ReadAttributeString('rel'); + FvalueString:=Node.ReadAttributeString('valueString'); + if Node.NodeCount>0 then // EntryLink + begin + FEntryLink.ParseXML(Node.FindNode('gd:entry')); + end; + except + Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdEntryLinkStruct } + +function TgdEntryLink.AddToXML(Root: TXMLNode): TXMLNode; +begin +if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_EntryLink)); + if Length(Trim(Fhref))>0 then + Result.WriteAttributeString('href',Fhref); + if Length(Trim(Frel))>0 then + Result.WriteAttributeString('rel',Frel); + Result.WriteAttributeBool('readOnly',FReadOnly); + if FAtomEntry<>nil then + Result.NodeAdd(FAtomEntry); +end; + +procedure TgdEntryLink.Clear; +begin + Fhref:=''; + Frel:=''; +end; + +constructor TgdEntryLink.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdEntryLink.IsEmpty: boolean; +begin + Result:=(Length(Trim(Fhref))=0)and(Length(Trim(Frel))=0) +end; + +procedure TgdEntryLink.ParseXML(Node: TXMLNode); +begin +if GetGDNodeType(Node.Name) <> gd_EntryLink then + raise Exception.Create + (Format(rcErrCompNodes, + [GetGDNodeName(gd_EntryLink)])); + try +// if Node.Attributes['href']<>null then + Fhref:=Node.ReadAttributeString('href'); +// if Node.Attributes['rel']<>null then + Frel:=Node.ReadAttributeString('rel'); +// if Node.Attributes['readOnly']<>null then + FReadOnly:=Node.ReadAttributeBool('readOnly'); + if Node.NodeCount>0 then // EntryLink + FAtomEntry:=Node.FindNode('entry'); + except + Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdEventStatus } + +function TgdEventStatus.AddToXML(Root: TXMLNode): TXMLNode; +begin +if Root=nil then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_EventStatus)); + Result.WriteAttributeString('value',SchemaHref+FValue); +end; + +procedure TgdEventStatus.Clear; +begin +FValue:='' +end; + +constructor TgdEventStatus.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdEventStatus.IsEmpty: boolean; +begin + Result:=Length(Trim(FValue))=0 +end; + +procedure TgdEventStatus.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_EventStatus then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_EventStatus)])); + try + // ShowMessage(Node.Attributes['value']); + FValue:=Node.ReadAttributeString('value'); + FValue:=StringReplace(FValue,SchemaHref,'',[rfIgnoreCase]); + FStatus:=TEventStatus(AnsiIndexStr(FValue, RelValues)); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdEventStatus.SetStatus(aStatus: TEventStatus); +begin + FStatus:=aStatus; + FValue:=RelValues[ord(aStatus)] +end; + +//procedure TgdEventStatus.SetValue(aValue: string); +//begin +// if AnsiIndexStr(aValue, RelValues)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdEventStatus)]])); +// FStatus:=TEventStatus(AnsiIndexStr(aValue, RelValues)); +// FValue:=aValue; +//end; + +{ TgdWhen } + +function TgdWhen.AddToXML(Root: TXMLNode;DateFormat:TDateFormat): TXMLNode; +begin + if (Root=nil)or isEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_When)); + case DateFormat of + tdDate:Result.WriteAttributeString('startTime',FormatDateTime('yyyy-mm-dd',FstartTime)); + tdServerDate:Result.WriteAttributeString('startTime',DateTimeToServerDate(FstartTime)); + end; + + if FendTime>0 then + Result.WriteAttributeString('endTime',DateTimeToServerDate(FendTime)); + if length(Trim(FvalueString))>0 then + Result.WriteAttributeString('valueString',FvalueString); +end; + +procedure TgdWhen.Clear; +begin + FendTime:=0; + FstartTime:=0; + FvalueString:=''; +end; + +constructor TgdWhen.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdWhen.isEmpty: boolean; +begin + Result:=FstartTime<=0;// +end; + +procedure TgdWhen.ParseXML(Node: TXMLNode); +begin +if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_When then + raise Exception.Create( + Format(rcErrCompNodes, + [GetGDNodeName(gd_When)])); + try + FendTime:=0; + FstartTime:=0; + FvalueString:=''; + if Node.HasAttribute('endTime') then + FendTime:=ServerDateToDateTime(Node.ReadAttributeString('endTime')); + FstartTime:=ServerDateToDateTime(Node.ReadAttributeString('startTime')); + if Node.HasAttribute('valueString') then + FvalueString:=Node.ReadAttributeString('valueString'); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdAttendeeStatus } + +function TgdAttendeeStatus.AddToXML(Root: TXMLNode): TXMLNode; +begin + if Root=nil then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_AttendeeStatus)); + Result.WriteAttributeString('value',SchemaHref+FValue); +end; + +procedure TgdAttendeeStatus.Clear; +begin + FValue:=''; +end; + +constructor TgdAttendeeStatus.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdAttendeeStatus.isEmpty: boolean; +begin + Result:=Length(Trim(FValue))=0 +end; + +procedure TgdAttendeeStatus.ParseXML(Node: TXMLNode); +begin +if (Node=nil)or isEmpty then Exit; + if GetGDNodeType(Node.Name) <> gd_AttendeeStatus then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_AttendeeStatus)])); + try + FValue := Node.ReadAttributeString('value'); + FValue:=StringReplace(FValue,SchemaHref,'',[rfIgnoreCase]); + FAttendeeStatus := TAttendeeStatus(AnsiIndexStr(FValue, RelValues)); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdAttendeeStatus.SetStatus(aStatus: TAttendeeStatus); +begin + FAttendeeStatus:=aStatus; + FValue:=RelValues[ord(aStatus)] +end; + +//procedure TgdAttendeeStatus.SetValue(aValue: string); +//begin +// if AnsiIndexStr(aValue, cAttendeeStatus)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdAttendeeStatus)]])); +// FAttendeeStatus:=TAttendeeStatus(AnsiIndexStr(aValue, cAttendeeStatus)); +// FValue:=aValue; +//end; + +{ TgdAttendeeType } + +function TgdAttendeeType.AddToXML(Root: TXMLNode): TXMLNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_AttendeeType)); + Result.WriteAttributeString('value',SchemaHref+FValue); +end; + +procedure TgdAttendeeType.Clear; +begin + FValue:=''; +end; + +constructor TgdAttendeeType.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdAttendeeType.IsEmpty: boolean; +begin +Result:=Length(Trim(FValue))=0; +end; + +procedure TgdAttendeeType.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_AttendeeType then + raise Exception.Create( + Format(rcErrCompNodes, + [GetGDNodeName(gd_AttendeeType)])); + try + FValue:=Node.ReadAttributeString('value'); + FValue:=StringReplace(FValue,SchemaHref,'',[rfIgnoreCase]); + FAttType := TAttendeeType(AnsiIndexStr(FValue, RelValues)); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdAttendeeType.SetType(aStatus: TAttendeeType); +begin + FAttType:=aStatus; + FValue:=RelValues[ord(aStatus)] +end; + +//procedure TgdAttendeeType.SetValue(aValue: string); +//begin +// if AnsiIndexStr(aValue, cAttendeeType)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdAttendeeType)]])); +// FAttType:=TAttendeeType(AnsiIndexStr(aValue, cAttendeeType)); +// FValue:=aValue; +//end; + +{ TgdWho } + +function TgdWho.AddToXML(Root: TXMLNode): TXMLNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Who)); + if Length(Trim(FEmail))>0 then + Result.WriteAttributeString('email',FEmail); + if Length(Trim(Frel))>0 then + Result.WriteAttributeString('rel',SchemaHref+RelValues[ord(FRelValue)]); + if Length(Trim(FvalueString))>0 then + Result.WriteAttributeString('valueString',FvalueString); + FAttendeeStatus.AddToXML(Result); + FAttendeeType.AddToXML(Result); + FEntryLink.AddToXML(Result); +end; + +procedure TgdWho.Clear; +begin +FEmail:=''; +Frel:=''; +FvalueString:=''; +FAttendeeStatus.Clear; +FAttendeeType.Clear; +FEntryLink.Clear; +end; + +constructor TgdWho.Create(const ByNode: TXMLNode); +begin + inherited Create; + FAttendeeStatus:= TgdAttendeeStatus.Create; + FAttendeeType:= TgdAttendeeType.Create; + FEntryLink:= TgdEntryLink.Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdWho.IsEmpty: boolean; +begin + Result:=(Length(Trim(FEmail))=0)and(Length(Trim(Frel))=0)and + (Length(Trim(FvalueString))=0) and + (FAttendeeStatus.isEmpty) and + (FAttendeeType.IsEmpty) and + (FEntryLink.IsEmpty) +end; + +procedure TgdWho.ParseXML(Node: TXMLNode); +var i:integer; + s:string; +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Who then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Who)])); + try +// if Node.Attributes['email']<>null then + FEmail:=Node.ReadAttributeString('email'); + if Length(Node.ReadAttributeString('rel'))>0 then + begin + S:=Node.ReadAttributeString('rel'); + S:=StringReplace(S,SchemaHref,'',[rfIgnoreCase]); + FRelValue:=TWhoRel(AnsiIndexStr(S, RelValues)); + end; + FvalueString:=Node.ReadAttributeString('valueString'); + if Node.NodeCount>0 then + begin + for I := 0 to Node.NodeCount-1 do + case GetGDNodeType(Node.Nodes[i].Name) of + gd_AttendeeStatus: + FAttendeeStatus:=TgdAttendeeStatus.Create(Node.Nodes[i]); + gd_AttendeeType: + FAttendeeType:=TgdAttendeeType.Create(Node.Nodes[i]); + gd_EntryLink: + FEntryLink:=TgdEntryLink.Create(Node.Nodes[i]); + end; + end; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +//procedure TgdWho.SetRel(aRel: string); +//begin +//if AnsiIndexStr(aRel, cWhoRel)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdWho)]])); +// FRelValue:=TWhoRel(AnsiIndexStr(aRel, cWhoRel)); +// Frel:=aRel; +//end; + +//procedure TgdWho.SetRelValue(aRelValue: TWhoRel); +//begin +// FRelValue:=aRelValue; +// // Frel:=cWhoRel[ord(aRelValue)] +//end; + +{ TgdRecurrence } + +function TgdRecurrence.AddToXML(Root: TXMLNode): TXMLNode; +begin +if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Recurrence)); + Result.ValueAsString:=FText.Text; +end; + +procedure TgdRecurrence.Clear; +begin + FText.Clear; +end; + +constructor TgdRecurrence.Create(const ByNode: TXMLNode); +begin + inherited Create; + FText:=TStringList.Create; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdRecurrence.IsEmpty: boolean; +begin + Result:=FText.Count=0 +end; + +procedure TgdRecurrence.ParseXML(Node: TXMLNode); +begin +if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Recurrence then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Recurrence)])); + try + FText.Text:=Node.ValueAsString; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdReminder } + +function TgdReminder.AddToXML(Root:TXMLNode): TXMLNode; +begin + if Root=nil then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Reminder)); + Result.WriteAttributeString('method',cMethods[ord(Fmethod)]); + case FPeriod of + tpDays: Result.WriteAttributeInteger('days',FPeriodValue); + tpHours: Result.WriteAttributeInteger('hours',FPeriodValue); + tpMinutes: Result.WriteAttributeInteger('minutes',FPeriodValue); + end; + if FabsoluteTime>0 then + Result.WriteAttributeString('absoluteTime',DateTimeToServerDate(FabsoluteTime)) +end; + +constructor TgdReminder.Create(const ByNode: TXMLNode); +begin + inherited Create; + FabsoluteTime:=0; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +procedure TgdReminder.ParseXML(Node: TXMLNode); +begin +if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Reminder then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Reminder)])); + try + if Length(Node.ReadAttributeString('absoluteTime'))>0 then + FabsoluteTime:=ServerDateToDateTime(Node.ReadAttributeString('absoluteTime')); + if length(Node.ReadAttributeString('method'))>0 then + Fmethod:=TMethod(AnsiIndexStr(Node.ReadAttributeString('method'), cMethods)); + if Node.AttributeIndexByname('days')>=0 then + FPeriod:=tpDays; + if Node.AttributeIndexByname('hours')>=0 then + FPeriod:=tpHours; + if Node.AttributeIndexByname('minutes')>=0 then + FPeriod:=tpMinutes; + case FPeriod of + tpDays: FPeriodValue:=Node.ReadAttributeInteger('days'); + tpHours: FPeriodValue:=Node.ReadAttributeInteger('hours'); + tpMinutes: FPeriodValue:=Node.ReadAttributeInteger('minutes'); + end; + + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdTransparency } + +function TgdTransparency.AddToXML(Root: TXMLNode): TXMLNode; +begin +if (Root=nil)or IsEmpty then Exit; +Result:=Root.NodeNew(GetGDNodeName(gd_Transparency)); +Result.WriteAttributeString('value',SchemaHref+FValue); +end; + +procedure TgdTransparency.Clear; +begin + FValue:=''; +end; + +constructor TgdTransparency.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdTransparency.IsEmpty: boolean; +begin + Result:=Length(Trim(FValue))=0 +end; + +procedure TgdTransparency.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Transparency then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Transparency)])); + try + FValue := Node.ReadAttributeString('value'); + FValue:=StringReplace(FValue,SchemaHref,'',[rfIgnoreCase]); + FTransparency := TTransparency(AnsiIndexStr(FValue, RelValues)); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdTransparency.SetTransp(aTransp: TTransparency); +begin + FTransparency:=aTransp; + FValue:=RelValues[ord(aTransp)] +end; + +//procedure TgdTransparency.SetValue(aValue: string); +//begin +//if AnsiIndexStr(aValue, cTransparency)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdTransparency)]])); +// FTransparency:=TTransparency(AnsiIndexStr(aValue, cTransparency)); +// FValue:=aValue; +//end; + +{ TgdVisibility } + +function TgdVisibility.AddToXML(Root: TXMLNode): TXMLNode; +begin +if (Root=nil)or IsEmpty then Exit; +Result:=Root.NodeNew(GetGDNodeName(gd_Visibility)); +Result.WriteAttributeString('value',SchemaHref+FValue); +end; + +procedure TgdVisibility.Clear; +begin + FValue:=''; +end; + +constructor TgdVisibility.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode=nil then Exit; + ParseXML(ByNode); +end; + +function TgdVisibility.IsEmpty: boolean; +begin + Result:=Length(Trim(FValue))=0 +end; + +procedure TgdVisibility.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Visibility then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Visibility)])); + try + FValue := Node.ReadAttributeString('value'); + FValue:=StringReplace(FValue,SchemaHref,'',[rfIgnoreCase]); + FVisible := TVisibility(AnsiIndexStr(FValue, RelValues)); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +//procedure TgdVisibility.SetValue(aValue: string); +//begin +//if AnsiIndexStr(aValue, RelValues)<=0 then +// raise Exception.Create(Format(rcErrMissValue, [cGDTagNames[ord(egdVisibility)]])); +// FVisible:=TVisibility(AnsiIndexStr(aValue, RelValues)); +// FValue:=aValue; +//end; + +procedure TgdVisibility.SetVisible(aVisible: TVisibility); +begin + FVisible:=aVisible; + FValue:=RelValues[ord(aVisible)] +end; + +{ TgdOrganization } + +function TgdOrganization.AddToXML(Root: TXMLNode): TXmlNode; +begin +if (Root=nil)or IsEmpty then Exit; + + +Result:=Root.NodeNew(GetGDNodeName(gd_Organization)); +if Trim(FRel)<>'' then + Result.WriteAttributeString('rel',FRel); +if Trim(FLabel)<>'' then + Result.WriteAttributeString('label',FLabel); +if FPrimary then + Result.WriteAttributeBool('primary',Fprimary); +if Trim(ForgName.Value)<>'' then + ForgName.AddToXML(Result); +if Trim(ForgTitle.Value)<>'' then + ForgTitle.AddToXML(Result); +end; + +procedure TgdOrganization.Clear; +begin + FLabel:=''; + Frel:=''; +end; + +constructor TgdOrganization.Create(ByNode: TXMLNode); +begin + inherited Create; + ForgName:=TgdOrgName.Create; + ForgTitle:=TgdOrgTitle.Create; + Clear; + if ByNode<>nil then + ParseXML(ByNode); + +end; + +function TgdOrganization.IsEmpty: boolean; +begin + Result:=(Length(Trim(FLabel))=0)and(Length(Trim(Frel))=0)and(ForgName.IsEmpty)and(ForgTitle.IsEmpty) +end; + +procedure TgdOrganization.ParseXML(const Node: TXmlNode); +var i:integer; +begin +if (Node=nil)or IsEmpty then Exit; + if GetGDNodeType(Node.Name) <> gd_Organization then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Organization)])); + try + Frel:=Node.ReadAttributeString('rel'); + if Node.HasAttribute('primary') then + Fprimary:=Node.ReadAttributeBool('primary'); + if Node.HasAttribute('label') then + FLabel:=Node.ReadAttributeString('label'); + for i:=0 to Node.NodeCount-1 do + begin + if LowerCase(Node.Nodes[i].Name)=LowerCase(GetGDNodeName(gd_OrgName)) then + ForgName:=TgdOrgName.Create(Node.Nodes[i]) + else + if LowerCase(Node.Nodes[i].Name)=LowerCase(GetGDNodeName(gd_OrgTitle)) then + ForgTitle:=TgdOrgTitle.Create(Node.Nodes[i]); + end; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdEmailStruct } + +function TgdEmail.AddToXML(Root: TXMLNode): TXmlNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Email)); + if Trim(FRel)<>'' then + Result.WriteAttributeString('rel',FRel); + if Trim(FLabel)<>'' then + Result.WriteAttributeString('label',FLabel); + if Trim(FLabel)<>'' then + Result.WriteAttributeString('displayName',FDisplayName); + if FPrimary then + Result.WriteAttributeBool('primary',FPrimary); + Result.WriteAttributeString('address',FAddress); +end; + +procedure TgdEmail.Clear; +begin + FAddress:=''; + FLabel:=''; + FRel:=''; + FDisplayName:=''; +end; + +constructor TgdEmail.Create(ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdEmail.IsEmpty: boolean; +begin + Result:=Length(Trim(FAddress))=0;// +end; + +procedure TgdEmail.ParseXML(const Node: TXmlNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Email then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Email)])); + try + Frel:=Node.ReadAttributeString('rel'); + if Node.HasAttribute('primary') then + Fprimary:=Node.ReadAttributeBool('primary'); + if Node.HasAttribute('label') then + FLabel:=Node.ReadAttributeString('label'); + if Node.HasAttribute('displayName') then + FDisplayName:=Node.ReadAttributeString('displayName'); + FAddress:=Node.ReadAttributeString('address'); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdEmail.SetEmailType(aType: TTypeElement); +begin +FEmailType:=aType; +SetRel(RelValues[ord(aType)]); +end; + +procedure TgdEmail.SetRel(const aRel: string); +begin + if AnsiIndexStr(aRel,RelValues)<0 then + raise Exception.Create + (Format(rcErrWriteNode, [GetGDNodeName(gd_Email)])+' '+Format(rcWrongAttr,['rel'])); + FRel:=SchemaHref+aRel; +end; + +{ TgdNameStruct } + +function TgdName.AddToXML(Root: TXMLNode): TXmlNode; +begin + if (Root=nil)or IsEmpty then Exit; + + Result:=Root.NodeNew(GetGDNodeName(gd_Name)); + if (AdditionalName<>nil)and(not AdditionalName.IsEmpty) then + AdditionalName.AddToXML(Result); + + if (GivenName<>nil)and(not GivenName.IsEmpty) then + GivenName.AddToXML(Result); + if (FamilyName<>nil)and(not FamilyName.IsEmpty) then + FamilyName.AddToXML(Result); + if (not NamePrefix.IsEmpty) then + NamePrefix.AddToXML(Result); + if not NameSuffix.IsEmpty then + NameSuffix.AddToXML(Result); + if not FullName.IsEmpty then + FullName.AddToXML(Result); +end; + +procedure TgdName.Clear; +begin + FGivenName.Clear; + FAdditionalName.Clear; + FFamilyName.Clear; + FNamePrefix.Clear; + FNameSuffix.Clear; + FFullName.Clear; +end; + +constructor TgdName.Create(ByNode: TXMLNode); +begin + inherited Create; + FGivenName:=TgdGivenName.Create(GetGDNodeName(gd_givenName)); + FAdditionalName:=TgdAdditionalName.Create(GetGDNodeName(gd_additionalName)); + FFamilyName:=TgdFamilyName.Create(GetGDNodeName(gd_familyName)); + FNamePrefix:=TgdNamePrefix.Create(GetGDNodeName(gd_namePrefix)); + FNameSuffix:=TgdNameSuffix.Create(GetGDNodeName(gd_nameSuffix)); + FFullName:=TgdFullName.Create(GetGDNodeName(gd_fullName)); + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdName.GetFullName: string; +begin + if FFullName<>nil then + Result:=FFullName.Value; +end; + +function TgdName.IsEmpty: boolean; +begin +Result:= FGivenName.IsEmpty and FAdditionalName.IsEmpty and + FFamilyName.IsEmpty and FNamePrefix.IsEmpty and + FNameSuffix.IsEmpty and FFullName.IsEmpty; +end; + +procedure TgdName.ParseXML(const Node: TXmlNode); +var i:integer; +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Name then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Name)])); + try + for i:=0 to Node.NodeCount-1 do + begin + case GetGDNodeType(Node.Nodes[i].Name) of + gd_GivenName:FGivenName.ParseXML(Node.Nodes[i]); + gd_AdditionalName:FAdditionalName.ParseXML(Node.Nodes[i]); + gd_FamilyName:FFamilyName.ParseXML(Node.Nodes[i]); + gd_NamePrefix:FNamePrefix.ParseXML(Node.Nodes[i]); + gd_NameSuffix:FNameSuffix.ParseXML(Node.Nodes[i]); + gd_FullName:FFullName.ParseXML(Node.Nodes[i]); + end; + end; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +procedure TgdName.SetAdditionalName(aAdditionalName: TTextTag); +begin +if aAdditionalName=nil then Exit; +if length(FAdditionalName.Name)=0 then + FAdditionalName.Name:='gd:additionalName'; +FAdditionalName.Value:=aAdditionalName.Value; +end; + +procedure TgdName.SetFamilyName(aFamilyName: TTextTag); +begin +if aFamilyName=nil then Exit; +if length(FFamilyName.Name)=0 then + FFamilyName.Name:='gd:familyName'; +FFamilyName.Value:=aFamilyName.Value; +end; + +procedure TgdName.SetFullName(aFullName: TTextTag); +begin +if aFullName=nil then Exit; +if length(FFullName.Name)=0 then + FFullName.Name:='gd:fullName'; +FFullName.Value:=aFullName.Value; +end; + +procedure TgdName.SetGivenName(aGivenName: TTextTag); +begin +if aGivenName=nil then Exit; +if length(FGivenName.Name)=0 then + FGivenName.Name:='gd:givenName'; +FFullName.Value:=aGivenName.Value; +end; + +procedure TgdName.SetNamePrefix(aNamePrefix: TTextTag); +begin +if aNamePrefix=nil then Exit; +if length(FNamePrefix.Name)=0 then + FNamePrefix.Name:='gd:namePrefix'; +FNamePrefix.Value:=aNamePrefix.Value; +end; + +procedure TgdName.SetNameSuffix(aNameSuffix: TTextTag); +begin + if aNameSuffix=nil then Exit; +if length(FNameSuffix.Name)=0 then + FNameSuffix.Name:='gd:nameSuffix'; +FNameSuffix.Value:=aNameSuffix.Value; +end; + +{ TgdPhoneNumber } + +function TgdPhoneNumber.AddToXML(Root: TXMLNode): TXmlNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_PhoneNumber)); + Result.WriteAttributeString('rel',SchemaHref+RelValues[ord(FPhoneType)]); + Result.ValueAsString:=FValue; + if Trim(FLabel)<>'' then + Result.WriteAttributeString('label',FLabel); + if Trim(FUri)<>'' then + Result.WriteAttributeString('uri',FUri); + if FPrimary then + Result.WriteAttributeBool('primary',FPrimary); +end; + +procedure TgdPhoneNumber.Clear; +begin + FLabel:=''; + FUri:=''; + FValue:=''; +end; + +constructor TgdPhoneNumber.Create(ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdPhoneNumber.IsEmpty: boolean; +begin + Result:=(Length(Trim(FLabel))=0)and(Length(Trim(FUri))=0)and(Length(Trim(FValue))=0) +end; + +procedure TgdPhoneNumber.ParseXML(const Node: TXmlNode); +var s:string; +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_PhoneNumber then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_PhoneNumber)])); + try + s:=Node.ReadAttributeString('rel'); + s:=StringReplace(s,SchemaHref,'',[rfIgnoreCase]); + if AnsiIndexStr(s,RelValues)>-1 then + FPhoneType:=TPhonesRel(AnsiIndexStr(s,RelValues)) + else + FPhoneType:=tpOther; + if Node.HasAttribute('primary') then + Fprimary:=Node.ReadAttributeBool('primary'); + if Node.HasAttribute('label') then + FLabel:=Node.ReadAttributeString('label'); + if Node.HasAttribute('uri') then + FUri:=Node.ReadAttributeString('uri'); + FValue:=Node.ValueAsString; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +//procedure TgdPhoneNumber.SetRel(aPhoneRel: TPhonesRel); +//begin +// FPhoneType:=aPhoneRel; +//end; + +{ TgdCountry } + +function TgdCountry.AddToXML(Root: TXMLNode): TXMLNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Country)); + if Trim(FCode)<>'' then + Result.WriteAttributeString('code',FCode); + Result.ValueAsString:=FValue; +end; + +procedure TgdCountry.Clear; +begin + FCode:=''; + FValue:=''; +end; + +constructor TgdCountry.Create(const ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdCountry.IsEmpty: boolean; +begin +Result:=(Length(Trim(FCode))=0)and (Length(Trim(FValue))=0); +end; + +procedure TgdCountry.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Country then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Country)])); + try + FCode:=Node.ReadAttributeString('rel'); + FValue:=Node.ValueAsString; + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TgdStructuredPostalAddressStruct } + +function TgdStructuredPostalAddress.AddToXML(Root: TXMLNode): TXMLNode; +begin + if (Root=nil) or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_StructuredPostalAddress)); + if Trim(FRel)<>'' then + Result.WriteAttributeString('rel',FRel); + if Trim(FMailClass)<>'' then + Result.WriteAttributeString('mailClass',FMailClass); + if Trim(Flabel)<>'' then + Result.WriteAttributeString('label',Flabel); + if Trim(FUsage)<>'' then + Result.WriteAttributeString('Usage',FUsage); + if Fprimary then + Result.WriteAttributeBool('primary',Fprimary); + if FAgent<>nil then + FAgent.AddToXML(Result); + if FHousename<>nil then + FHousename.AddToXML(Result); + if FStreet<>nil then + FStreet.AddToXML(Result); + if FPobox<>nil then + FPobox.AddToXML(Result); + if FNeighborhood<>nil then + FNeighborhood.AddToXML(Result); + if FCity<>nil then + FCity.AddToXML(Result); + if FSubregion<>nil then + FSubregion.AddToXML(Result); + if FRegion<>nil then + FRegion.AddToXML(Result); + if FPostcode<>nil then + FPostcode.AddToXML(Result); + if FCountry<>nil then + FCountry.AddToXML(Result); + if FFormattedAddress<>nil then + FFormattedAddress.AddToXML(Result); +end; + +procedure TgdStructuredPostalAddress.Clear; +begin + FRel:=''; + FMailClass:=''; + FUsage:=''; + Flabel:=''; + FAgent.Clear; + FHouseName.Clear; + FStreet.Clear; + FPobox.Clear; + FNeighborhood.Clear; + FCity.Clear; + FSubregion.Clear; + FRegion.Clear; + FPostcode.Clear; + FCountry.Clear; + FFormattedAddress.Clear; +end; + +constructor TgdStructuredPostalAddress.Create(const ByNode: TXMLNode); +begin + inherited Create; + FAgent:= TgdAgent.Create; + FHouseName:= TgdHousename.Create; + FStreet:= TgdStreet.Create; + FPobox:= TgdPobox.Create; + FNeighborhood:= TgdNeighborhood.Create; + FCity:= TgdCity.Create; + FSubregion:= TgdSubregion.Create; + FRegion:= TgdRegion.Create; + FPostcode:= TgdPostcode.Create; + FCountry:= TgdCountry.Create; + FFormattedAddress:= TgdFormattedAddress.Create; + + Clear; + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdStructuredPostalAddress.IsEmpty: boolean; +begin +Result:=(Length(Trim(FRel))=0)and (Length(Trim(FMailClass))=0)and +(Length(Trim(FUsage))=0)and(Length(Trim(Flabel))=0)and +FAgent.IsEmpty and +FHouseName.IsEmpty and +FStreet.IsEmpty and +FPobox.IsEmpty and +FNeighborhood.IsEmpty and +FCity.IsEmpty and +FSubregion.IsEmpty and +FRegion.IsEmpty and +FPostcode.IsEmpty and +FCountry.IsEmpty and +FFormattedAddress.IsEmpty; +end; + +procedure TgdStructuredPostalAddress.ParseXML(Node: TXMLNode); +var i:integer; +begin +if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_StructuredPostalAddress then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_StructuredPostalAddress)])); + try + FRel:=Node.ReadAttributeString('rel'); + FMailClass:=Node.ReadAttributeString('mailClass'); + Flabel:=Node.ReadAttributeString('label'); + if Node.HasAttribute('primaty') then + Fprimary:=Node.ReadAttributeBool('primary'); + FUsage:=Node.ReadAttributeString('Usage'); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; + for I := 0 to Node.NodeCount - 1 do + begin + case GetGDNodeType(Node.Nodes[i].Name) of + gd_Agent:FAgent.ParseXML(Node.Nodes[i]); + gd_Housename:FHousename.ParseXML(Node.Nodes[i]); + gd_Street:FStreet.ParseXML(Node.Nodes[i]); + gd_Pobox:FPobox.ParseXML(Node.Nodes[i]); + gd_Neighborhood:FNeighborhood.ParseXML(Node.Nodes[i]); + gd_City:FCity.ParseXML(Node.Nodes[i]); + gd_Subregion:FSubregion.ParseXML(Node.Nodes[i]); + gd_Region:FRegion.ParseXML(Node.Nodes[i]); + gd_Postcode:FPostcode.ParseXML(Node.Nodes[i]); + gd_Country:FCountry.ParseXML(Node.Nodes[i]); + gd_FormattedAddress:FFormattedAddress.ParseXML(Node.Nodes[i]); + end; + end; +end; + +{ TgdIm } + +function TgdIm.AddToXML(Root: TXMLNode): TXmlNode; +begin + if (Root=nil)or IsEmpty then Exit; + Result:=Root.NodeNew(GetGDNodeName(gd_Im)); + + Result.WriteAttributeString('rel',SchemaHref+RelValues[ord(FIMType)]); + Result.WriteAttributeString('address',FAddress); + Result.WriteAttributeString('label',FLabel); + Result.WriteAttributeString('protocol',SchemaHref+ProtocolValues[ord(FIMProtocol)]); + if FPrimary then + Result.WriteAttributeBool('primary',FPrimary); +end; + +procedure TgdIm.Clear; +begin + FAddress:=''; + FLabel:=''; +end; + +constructor TgdIm.Create(ByNode: TXMLNode); +begin + inherited Create; + Clear; + if ByNode<>nil then + ParseXML(ByNode); +end; + +function TgdIm.IsEmpty: boolean; +begin + Result:=(Length(Trim(FAddress))=0);// +end; + +procedure TgdIm.ParseXML(const Node: TXmlNode); +var s:string; +begin +if Node=nil then Exit; + if GetGDNodeType(Node.Name) <> gd_Im then + raise Exception.Create(Format(rcErrCompNodes, + [GetGDNodeName(gd_Im)])); + try + s:=Node.ReadAttributeString('rel'); + s:=StringReplace(s,SchemaHref,'',[rfIgnoreCase]); + FIMType:=TImtype(AnsiIndexStr(s,RelValues)); + FLabel:=Node.ReadAttributeString('label'); + FAddress:=Node.ReadAttributeString('address'); + s:=Node.ReadAttributeString('protocol'); + s:=StringReplace(s,SchemaHref,'',[rfIgnoreCase]); + if AnsiIndexStr(s,ProtocolValues)>-1 then + FIMProtocol:=TIMProtocol(AnsiIndexStr(s,ProtocolValues)) + else + FIMProtocol:=tiGOOGLE_TALK; + if Node.HasAttribute('primary') then + FPrimary:=Node.ReadAttributeBool('primary'); + except + raise Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +end. +>>>>>>> remotes/origin/Vlad55 >>>>>>> remotes/origin/NMD diff --git a/source/GHelper.pas b/source/GHelper.pas index 6025c07..8ff388f 100644 --- a/source/GHelper.pas +++ b/source/GHelper.pas @@ -1,3 +1,4 @@ +<<<<<<< HEAD unit GHelper; interface @@ -238,6 +239,9 @@ procedure TTimeZoneList.SetRecord(index: Integer; Ptr: PTimeZone); end. ======= +======= +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD unit GHelper; interface @@ -1033,4 +1037,482 @@ procedure TEntryLink.ParseXML(Node: TXMLNode); end; end. +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD +======= +======= +unit GHelper; + +interface + +uses Graphics,strutils,Windows,DateUtils,SysUtils, Variants, +Classes,StdCtrls,httpsend,Generics.Collections,xmlintf,xmldom,NativeXML, +uLanguage; + +//{$I languages\lang_russian.inc} + +const + GoogleColors: array [1..21]of string = ('A32929','B1365F','7A367A','5229A3', + '29527A','2952A3','1B887A','28754E', + '0D7813','528800','88880E','AB8B00', + 'BE6D00','B1440E','865A5A','705770', + '4E5D6C','5A6986','4A716C','6E6E41', + '8D6F47'); + + NodeValueAttr = 'value'; + EntryNodeName = 'entry'; + SchemaHref ='http://schemas.google.com/g/2005#'; + + gdRelValues: array [1..25,1..2] of string = ( + ('http://schemas.google.com/g/2005#event',''), + ('http://schemas.google.com/g/2005#event.alternate',''), + ('http://schemas.google.com/g/2005#event.parking',''), + ('http://schemas.google.com/g/2005#message.bcc',''), + ('http://schemas.google.com/g/2005#message.cc',''), + ('http://schemas.google.com/g/2005#message.from',''), + ('http://schemas.google.com/g/2005#message.reply-to',''), + ('http://schemas.google.com/g/2005#message.to',''), + ('http://schemas.google.com/g/2005#regular',''), + ('http://schemas.google.com/g/2005#reviews',''), + ('http://schemas.google.com/g/2005#home',''), + ('http://schemas.google.com/g/2005#other',''), + ('http://schemas.google.com/g/2005#work',''), + ('http://schemas.google.com/g/2005#fax',''), + ('http://schemas.google.com/g/2005#home_fax',''), + ('http://schemas.google.com/g/2005#mobile',''), + ('http://schemas.google.com/g/2005#pager',''), + ('http://schemas.google.com/g/2005#work_fax',''), + ('http://schemas.google.com/g/2005#overall',''), + ('http://schemas.google.com/g/2005#price',''), + ('http://schemas.google.com/g/2005#quality',''), + ('http://schemas.google.com/g/2005#event.attendee',''), + ('http://schemas.google.com/g/2005#event.organizer',''), + ('http://schemas.google.com/g/2005#event.performer',''), + ('http://schemas.google.com/g/2005#event.speaker','')); + +// +clNameSpaces: array [0 .. 2, 0 .. 1] of string = + (('', 'http://www.w3.org/2005/Atom'), ('gd', + 'http://schemas.google.com/g/2005'), ('gCal', + 'http://schemas.google.com/gCal/2005')); +// rel category +clCategories: array [0 .. 1, 0 .. 1] of string = (('scheme', + 'http://schemas.google.com/g/2005#kind'), ('term', + 'http://schemas.google.com/g/2005#event')); + +type + TTimeZone = packed record + gConst: string; + Desc : string; + GMT: extended; + rus: boolean; +end; + +type + PTimeZone = ^TTimeZone; + +type + TTimeZoneList = class(TList) + private + procedure SetRecord(index: Integer; Ptr: PTimeZone); + function GetRecord(index: Integer): PTimeZone; + public + constructor Create; + procedure Clear; + destructor Destroy; override; + property TimeZone[i: Integer]: PTimeZone read GetRecord write SetRecord; + end; + + +type + TAttribute = packed record + Name: string; + Value: string; + end; + +type + TTextTag = class + private + FName: string; + FValue: string; + FAtributes: TList; + public + Constructor Create(const ByNode: TXMLNode=nil);overload; + constructor Create(const NodeName: string; NodeValue:string='');overload; + + function IsEmpty: boolean; + procedure Clear; + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root: TXMLNode): TXMLNode; + property Value: string read FValue write FValue; + property Name: string read FName write FName; + property Attributes: TListread FAtributes write FAtributes; + end; + +type + TEntryLink = class + private + Frel: string; + Ftype: string; + Fhref: string; + FEtag: string; + public + Constructor Create(const ByNode: TXMLNode=nil); + procedure ParseXML(Node: TXMLNode); + function AddToXML(Root: TXMLNode): TXMLNode; + property Rel: string read Frel write Frel; + property Ltype: string read Ftype write Ftype; + property Href: string read Fhref write Fhref; + property Etag: string read FEtag write FEtag; + end; + +type + TAuthorTag = Class + private + FAuthor: string; + FEmail : string; + FUID : string; + public + constructor Create(ByNode: IXMLNode=nil); + procedure ParseXML(Node: IXMLNode); + property Author: string read FAuthor write FAuthor; + property Email: string read FEmail write FEmail; + end; + + +function HexToColor(Color: string): TColor; +function ColorToHex(Color: TColor): string; +// 2007-07-11T21:50:15.000Z TDateTime +function ServerDateToDateTime(cServerDate:string):TDateTime; +// TDateTime 2007-07-11T21:50:15.000Z +function DateTimeToServerDate(DateTime:TDateTime):string; +// +function ArrayToStr(Values:array of string; Delimiter:char):string; +// HTTP +function GetNewLocationURL(Headers: TStringList):string; +function SendRequest(const aMethod, aURL, aAuth, ApiVersion: string; aDocument:TStream=nil; aExtendedHeaders:TStringList=nil):TStream; + + +implementation + +function ArrayToStr(Values:array of string; Delimiter:char):string; +var i:integer; +begin + if length(Values)=0 then Exit; + Result:=Values[0]; + for i:= 1 to Length(Values)-1 do + Result:=Result+Delimiter+Values[i] +end; + +function SendRequest(const aMethod, aURL, aAuth, ApiVersion: string; aDocument:TStream; aExtendedHeaders:TStringList):TStream; +var tmpURL:string; + i:integer; +begin + with THTTPSend.Create do + begin + Headers.Add('GData-Version: '+ApiVersion); + Headers.Add('Authorization: GoogleLogin auth='+aAuth); + MimeType := 'application/atom+xml'; + if aExtendedHeaders<>nil then + begin + for I:=0 to aExtendedHeaders.Count - 1 do + Headers.Add(aExtendedHeaders[i]) + end; + if aDocument<>nil then + Document.LoadFromStream(aDocument); + + HTTPMethod(aMethod,aURL); + if (ResultCode>200)and(ResultCode<400) then + begin + tmpURL:=GetNewLocationURL(Headers); + Document.Clear; + Headers.Clear; + Headers.Add('GData-Version: 2'); + Headers.Add('Authorization: GoogleLogin auth='+aAuth); + MimeType := 'application/atom+xml'; + if aExtendedHeaders<>nil then + begin + for I:=0 to aExtendedHeaders.Count - 1 do + Headers.Add(aExtendedHeaders[i]) + end; + if aDocument<>nil then + Document.LoadFromStream(aDocument); + HTTPMethod(aMethod,tmpURL); + end; + Result:=TStringStream.Create(''); + Headers.SaveToFile('headers.txt'); + Document.SaveToStream(Result); + Result.Seek(0,soFromBeginning); + end; +end; + +function GetNewLocationURL(Headers: TStringList):string; +var i:integer; +begin + if not Assigned(Headers) then Exit; + for i:=0 to Headers.Count - 1 do + begin + if pos('location:',lowercase(Headers[i]))>0 then + begin + Result:=Trim(copy(Headers[i],10,length(Headers[i])-9)); + Exit; + end; + end; +end; + +function DateTimeToServerDate(DateTime:TDateTime):string; +var Year, Mounth, Day, hours, Mins, Seconds,MSec: Word; + aYear, aMounth, aDay, ahours, aMins, aSeconds,aMSec: string; +begin + DecodeDateTime(DateTime,Year, Mounth, Day, hours, Mins, Seconds,MSec); + aYear:=IntToStr(Year); + if Mounth<10 then aMounth:='0'+IntToStr(Mounth) + else aMounth:=IntToStr(Mounth); + if Day<10 then aDay:='0'+IntToStr(Day) + else aDay:=IntToStr(Day); + if hours<10 then ahours:='0'+IntToStr(hours) + else ahours:=IntToStr(hours); + if Mins<10 then aMins:='0'+IntToStr(Mins) + else aMins:=IntToStr(Mins); + if Seconds<10 then aSeconds:='0'+IntToStr(Seconds) + else aSeconds:=IntToStr(Seconds); + + case MSec of + 0..9:aMSec:='00'+IntToStr(MSec); + 10..99:aMSec:='0'+IntToStr(MSec); + else + aMSec:=IntToStr(MSec); + end; + Result:=aYear+'-'+aMounth+'-'+aDay+'T'+ahours+':'+aMins+':'+aSeconds+'.'+aMSec+'Z'; +end; + +function ServerDateToDateTime(cServerDate:string):TDateTime; +var Year, Mounth, Day, hours, Mins, Seconds,MSec: Word; +begin + Year:=StrToInt(copy(cServerDate,1,4)); + Mounth:=StrToInt(copy(cServerDate,6,2)); + Day:=StrToInt(copy(cServerDate,9,2)); + if Length(cServerDate)>10 then + begin + hours:=StrToInt(copy(cServerDate,12,2)); + Mins:=StrToInt(copy(cServerDate,15,2)); + Seconds:=StrToInt(copy(cServerDate,18,2)); + end + else + begin + hours:=0; + Mins:=0; + Seconds:=0; + end; + Result:=EncodeDateTime(Year, Mounth, Day, hours, Mins, Seconds,0) +end; + +function ColorToHex(Color: TColor): string; +begin + Result := + IntToHex(GetRValue(Color), 2 ) + + IntToHex(GetGValue(Color), 2 ) + + IntToHex(GetBValue(Color), 2 ); +end; + +function HexToColor(Color: string): TColor; +begin +if pos('#',Color)>0 then + Delete(Color,1,1); + Result := + RGB( + StrToInt('$' + Copy(Color, 1, 2)), + StrToInt('$' + Copy(Color, 3, 2)), + StrToInt('$' + Copy(Color, 5, 2)) + ); +end; + +{ TTimeZoneList } + +procedure TTimeZoneList.Clear; +var + i: Integer; + p: PTimeZone; +begin + for i := 0 to Pred(Count) do + begin + p := TimeZone[i]; + if p <> nil then + Dispose(p); + end; + inherited Clear; +end; + + +constructor TTimeZoneList.Create; +var i:integer; + Zone:PTimeZone; +begin + inherited Create; + for i:=0 to High(GoogleTimeZones) do + begin + New(Zone); + with Zone^ do + begin + gConst:=GoogleTimeZones[i,0]; + Desc:=GoogleTimeZones[i,1]; + GMT:=StrToFloat(GoogleTimeZones[i,2]); + rus:=GoogleTimeZones[i,2]='rus'; + end; + Add(Zone); + end; +end; + +destructor TTimeZoneList.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TTimeZoneList.GetRecord(index: Integer): PTimeZone; +begin + Result:= PTimeZone(Items[index]); +end; + +procedure TTimeZoneList.SetRecord(index: Integer; Ptr: PTimeZone); +var + p: PTimeZone; +begin + p := TimeZone[index]; + if p <> Ptr then + begin + if p <> nil then + Dispose(p); + Items[index] := Ptr; + end; +end; + + +{ TTextTag } + +function TTextTag.AddToXML(Root: TXMLNode): TXMLNode; +var + i: integer; +begin + if (Root=nil)or IsEmpty then Exit; + Result:= Root.NodeNew(FName); + Result.ValueAsString:=AnsiToUtf8(FValue); + for i := 0 to FAtributes.Count - 1 do + Result.AttributeAdd(FAtributes[i].Name,FAtributes[i].Value); + //Root.ChildNodes.Add(Result); +end; + +constructor TTextTag.Create(const ByNode: TXMLNode); +begin + inherited Create; + FAtributes:=TList.Create; + Clear; + if ByNode = nil then + Exit; + ParseXML(ByNode); +end; + +procedure TTextTag.Clear; +begin + FName:=''; + FValue:=''; + FAtributes.Clear; +end; + +constructor TTextTag.Create(const NodeName: string; NodeValue: string); +begin + inherited Create; + FName:=NodeName; + FValue:=NodeValue; + FAtributes:=TList.Create; +end; + +function TTextTag.IsEmpty: boolean; +begin + Result:=(Length(Trim(FName))=0)or + ((Length(Trim(FValue))=0)and(FAtributes.Count=0)); +end; + +procedure TTextTag.ParseXML(Node: TXMLNode); +var + i: integer; + Attr: TAttribute; +begin + try + FValue := Node.ValueAsString; + FName := Node.Name; + for i := 0 to Node.AttributeCount - 1 do + begin + Attr.Name := Node.AttributeName[i]; + Attr.Value := Node.AttributeValue[i]; + FAtributes.Add(Attr) + end; + except + Exception.Create(Format(rcErrPrepareNode, [Node.Name])); + end; +end; + +{ TAuthorTag } + +{ TAuthorTag } + +constructor TAuthorTag.Create(ByNode: IXMLNode); +begin + inherited Create; + if ByNode = nil then + Exit; + ParseXML(ByNode); +end; + +procedure TAuthorTag.ParseXML(Node: IXMLNode); +var + i: integer; +begin + try + for i := 0 to Node.ChildNodes.Count - 1 do + begin + if Node.ChildNodes[i].NodeName = 'name' then + FAuthor := Node.ChildNodes[i].Text + else + if Node.ChildNodes[i].NodeName = 'email' then + FEmail := Node.ChildNodes[i].Text + else + if Node.ChildNodes[i].NodeName = 'uid' then + FUID:=Node.ChildNodes[i].Text; + end; + except + Exception.Create(Format(rcErrPrepareNode, [Node.NodeName])); + end; +end; + + +{ TEntryLink } + +function TEntryLink.AddToXML(Root: TXMLNode): TXMLNode; +begin + +end; + +constructor TEntryLink.Create(const ByNode: TXMLNode); +begin + inherited Create; + if ByNode<>nil then + ParseXML(ByNode); +end; + +procedure TEntryLink.ParseXML(Node: TXMLNode); +begin + if Node=nil then Exit; + try + Frel:=Node.ReadAttributeString('rel'); + Ftype:=Node.ReadAttributeString('type'); + Fhref:=Node.ReadAttributeString('href'); + FEtag:=Node.ReadAttributeString('gd:etag') + except + Exception.Create(Format(rcErrPrepareNode, ['link'])); + end; +end; + +end. +>>>>>>> remotes/origin/Vlad55 >>>>>>> remotes/origin/NMD diff --git a/source/GoogleLogin.identcache b/source/GoogleLogin.identcache new file mode 100644 index 0000000..376c4cf Binary files /dev/null and b/source/GoogleLogin.identcache differ diff --git a/source/uLanguage.pas b/source/uLanguage.pas index 6d9112d..b9f1ca0 100644 --- a/source/uLanguage.pas +++ b/source/uLanguage.pas @@ -1,3 +1,4 @@ +<<<<<<< HEAD unit uLanguage; interface @@ -137,6 +138,9 @@ implementation end. ======= +======= +<<<<<<< HEAD +>>>>>>> remotes/origin/NMD unit uLanguage; {$DEFINE RUSSIAN} @@ -149,5 +153,24 @@ implementation begin +<<<<<<< HEAD +end. +>>>>>>> remotes/origin/NMD +======= +======= +unit uLanguage; + +{$DEFINE RUSSIAN} + +interface + +{$IFDEF RUSSIAN} +{$I languages\lang_russian.inc} +{$ENDIF} + +implementation + +begin +>>>>>>> remotes/origin/Vlad55 end. >>>>>>> remotes/origin/NMD