diff --git a/src/Olf.FMX.Streams.pas b/src/Olf.FMX.Streams.pas new file mode 100644 index 0000000..d9cf31e --- /dev/null +++ b/src/Olf.FMX.Streams.pas @@ -0,0 +1,72 @@ +unit Olf.FMX.Streams; + +interface + +uses + FMX.Graphics, + System.SysUtils, + System.Classes; + +procedure SaveBitmapToStream(ABitmap: TBitmap; AToStream: TStream); +function LoadBitmapFromStream(AFromStream: TStream): TBitmap; + +implementation + +procedure SaveBitmapToStream(ABitmap: TBitmap; AToStream: TStream); +var + ms: TMemoryStream; + size: int64; +begin + if not assigned(AToStream) then + raise exception.create('Need an existing stream to save the bitmap !'); + + if not assigned(ABitmap) then + begin + size := 0; + AToStream.WriteData(size); + end + else + begin + ms := TMemoryStream.create; + try + ABitmap.SaveToStream(ms); + size := ms.size; + AToStream.WriteData(size); + if (size > 0) then + begin + ms.Position := 0; + AToStream.CopyFrom(ms, size); + end; + finally + ms.free; + end; + end; +end; + +function LoadBitmapFromStream(AFromStream: TStream): TBitmap; +var + ms: TMemoryStream; + size: int64; +begin + if not assigned(AFromStream) then + raise exception.create('Need an existing stream to load the bitmap !'); + + if (AFromStream.ReadData(size) <> sizeof(size)) then + result := nil + else if (size < 1) then + result := nil + else + begin + ms := TMemoryStream.create; + try + ms.CopyFrom(AFromStream, size); + ms.Position := 0; + result := TBitmap.create; + result.LoadFromStream(ms); + finally + ms.free; + end; + end; +end; + +end. \ No newline at end of file diff --git a/src/Olf.FMX.TextImageFrame.fmx b/src/Olf.FMX.TextImageFrame.fmx new file mode 100644 index 0000000..0282edb --- /dev/null +++ b/src/Olf.FMX.TextImageFrame.fmx @@ -0,0 +1,6 @@ +object OlfFMXTextImageFrame: TOlfFMXTextImageFrame + HitTest = False + Size.Width = 320.000000000000000000 + Size.Height = 240.000000000000000000 + Size.PlatformDefault = False +end diff --git a/src/Olf.FMX.TextImageFrame.pas b/src/Olf.FMX.TextImageFrame.pas new file mode 100644 index 0000000..7b20061 --- /dev/null +++ b/src/Olf.FMX.TextImageFrame.pas @@ -0,0 +1,213 @@ +unit Olf.FMX.TextImageFrame; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, + System.Variants, + FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, + System.ImageList, FMX.ImgList; + +type + TOlfFMXTextImageFrame = class; + + TOlfFMXTIFOnGetImageIndexOfUnknowChar = function + (Sender: TOlfFMXTextImageFrame; AChar: char): integer of object; + + TOlfFMXTextImageFrame = class(TFrame) + private + FText: string; + FFont: TCustomImageList; + FOnGetImageIndexOfUnknowChar: TOlfFMXTIFOnGetImageIndexOfUnknowChar; + FLetterSpacing: single; + FSpaceWidth, FRealSpaceWidth: single; + procedure SetFont(const Value: TCustomImageList); + procedure SetText(const Value: string); + procedure SetOnGetImageIndexOfUnknowChar(const Value + : TOlfFMXTIFOnGetImageIndexOfUnknowChar); + procedure SetLetterSpacing(const Value: single); + procedure SetSpaceWidth(const Value: single); + protected + function AjoutImageEtRetourneLargeur(AImages: TCustomImageList; + AImageIndex: TImageIndex; AX: single): single; + procedure RefreshTexte; + public + property Font: TCustomImageList read FFont write SetFont; + property Text: string read FText write SetText; + property SpaceWidth: single read FSpaceWidth write SetSpaceWidth; + property LetterSpacing: single read FLetterSpacing write SetLetterSpacing; + property OnGetImageIndexOfUnknowChar: TOlfFMXTIFOnGetImageIndexOfUnknowChar + read FOnGetImageIndexOfUnknowChar write SetOnGetImageIndexOfUnknowChar; + constructor Create(AOwner: TComponent); override; + function RetourneLargeur(AImages: TCustomImageList; + AImageIndex: TImageIndex): single; + function getImageIndexOfChar(AChar: string): integer; + end; + +implementation + +{$R *.fmx} + +const + CPosChiffres = 0; + CPosMajuscules = CPosChiffres + 10; + CPosMinuscules = CPosMajuscules; + // Pas de minuscules dans les fontes prises sur ce jeu + CPosPonctuation = CPosMajuscules + 26; + // TODO : à modifier si nécessaire selon les fontes + + { TcadAffichageTexteGraphique } + +function TOlfFMXTextImageFrame.AjoutImageEtRetourneLargeur + (AImages: TCustomImageList; AImageIndex: TImageIndex; AX: single): single; +var + g: tglyph; + wi, hi: single; +begin + if (not assigned(AImages)) or (AImageIndex < 0) or + (AImageIndex >= AImages.Count) then + result := 0 + else + begin + g := tglyph.Create(self); + g.Parent := self; + wi := AImages.Destination[AImageIndex].Layers[0].MultiResBitmap[0].Width; + hi := AImages.Destination[AImageIndex].Layers[0].MultiResBitmap[0].height; + g.height := height; + g.Width := g.height * wi / hi; + g.Images := AImages; + g.ImageIndex := AImageIndex; + g.Position.x := AX; + g.Position.y := 0; + result := g.Width; + end; +end; + +constructor TOlfFMXTextImageFrame.Create(AOwner: TComponent); +begin + inherited; + name := ''; + FFont := nil; + FText := ''; + FLetterSpacing := 0; + FSpaceWidth := 0; + FRealSpaceWidth := 0; + FOnGetImageIndexOfUnknowChar := nil; +end; + +function TOlfFMXTextImageFrame.getImageIndexOfChar(AChar: string): integer; +begin + result := 0; + while (result < FFont.Count) and + (FFont.Destination[result].Layers[0].Name <> AChar) do + inc(result); + if (result >= FFont.Count) then + result := -1; +end; + +procedure TOlfFMXTextImageFrame.RefreshTexte; +var + i: integer; + x: single; + idx: integer; +begin + for i := childrencount - 1 downto 0 do + if (children[i] is tglyph) then + children[i].Free; + + x := 0; + if assigned(FFont) and (FText.Length > 0) then + for i := 0 to FText.Length - 1 do + begin + idx := getImageIndexOfChar(FText.Chars[i]); + if (idx < 0) and assigned(FOnGetImageIndexOfUnknowChar) then + idx := FOnGetImageIndexOfUnknowChar(self, FText.Chars[i]); + if (idx >= 0) then + x := x + AjoutImageEtRetourneLargeur(FFont, idx, x) + FLetterSpacing + else if (FText.Chars[i] = ' ') then + begin + if (FRealSpaceWidth < 1) then + begin + idx := getImageIndexOfChar('.'); + if (idx < 0) and assigned(FOnGetImageIndexOfUnknowChar) then + idx := FOnGetImageIndexOfUnknowChar(self, '.'); + if (idx >= 0) then + FRealSpaceWidth := RetourneLargeur(FFont, idx); + + idx := getImageIndexOfChar('i'); + if (idx < 0) and assigned(FOnGetImageIndexOfUnknowChar) then + idx := FOnGetImageIndexOfUnknowChar(self, 'i'); + if (idx >= 0) then + FRealSpaceWidth := RetourneLargeur(FFont, idx); + + idx := getImageIndexOfChar('I'); + if (idx < 0) and assigned(FOnGetImageIndexOfUnknowChar) then + idx := FOnGetImageIndexOfUnknowChar(self, 'I'); + if (idx >= 0) then + FRealSpaceWidth := RetourneLargeur(FFont, idx); + + idx := getImageIndexOfChar('1'); + if (idx < 0) and assigned(FOnGetImageIndexOfUnknowChar) then + idx := FOnGetImageIndexOfUnknowChar(self, '1'); + if (idx >= 0) then + FRealSpaceWidth := RetourneLargeur(FFont, idx); + end; + x := x + FRealSpaceWidth; + end; + end; + + Width := x; +end; + +function TOlfFMXTextImageFrame.RetourneLargeur(AImages: TCustomImageList; + AImageIndex: TImageIndex): single; +var + wi, hi: single; +begin + if (not assigned(AImages)) or (AImageIndex < 0) or + (AImageIndex >= AImages.Count) then + result := 0 + else + begin + wi := AImages.Destination[AImageIndex].Layers[0].MultiResBitmap[0].Width; + hi := AImages.Destination[AImageIndex].Layers[0].MultiResBitmap[0].height; + result := height * wi / hi; + end; +end; + +procedure TOlfFMXTextImageFrame.SetFont(const Value: TCustomImageList); +begin + FFont := Value; + FRealSpaceWidth := FSpaceWidth; + if (FText.Length > 0) then + RefreshTexte; +end; + +procedure TOlfFMXTextImageFrame.SetLetterSpacing(const Value: single); +begin + FLetterSpacing := Value; +end; + +procedure TOlfFMXTextImageFrame.SetOnGetImageIndexOfUnknowChar + (const Value: TOlfFMXTIFOnGetImageIndexOfUnknowChar); +begin + FOnGetImageIndexOfUnknowChar := Value; +end; + +procedure TOlfFMXTextImageFrame.SetSpaceWidth(const Value: single); +begin + FSpaceWidth := Value; + FRealSpaceWidth := FSpaceWidth; +end; + +procedure TOlfFMXTextImageFrame.SetText(const Value: string); +begin + FText := Value; + if not assigned(FFont) then + exit; + RefreshTexte; +end; + +// TODO : gérer changement de taille des chiffres en cas de resize de la zone + +end. diff --git a/src/Olf.RTL.DateAndTime.pas b/src/Olf.RTL.DateAndTime.pas new file mode 100644 index 0000000..bfa5ba4 --- /dev/null +++ b/src/Olf.RTL.DateAndTime.pas @@ -0,0 +1,248 @@ +unit Olf.RTL.DateAndTime; + +interface + +/// +/// Ressort la date du jour en AAAAMMJJ +/// +function DateToString8: string; overload; + +/// +/// Ressort la date passée en AAAAMMJJ +/// +function DateToString8(Const ADate: TDateTime): string; overload; + +/// +/// Get the TDate value of a YYYYMMDD string +/// +function Date8ToDate(Const Date8: string): tdate; + +/// +/// Transforme une date AAAAMMJJ dans son format d'affichage JJ/MM/AAAA +/// +function Date8ToString(Const Date8AAfficher: string): string; + +/// +/// Transforme une date AAAAMMJJ dans son format d'affichage AAAA-MM-JJ +/// +function Date8ToStringISO(Const Date8AAfficher: string): string; + +/// +/// Transforme une date AAAAMMJJ dans son format d'affichage RFC822 +/// +function Date8ToStringRFC822(Const Date8AAfficher: string): string; + +/// +/// Ressort l'heure en cours en HHMMSS +/// +function TimeToString6: string; overload; + +/// +/// Ressort l'heure passée en HHMMSS +/// +function TimeToString6(Const ATime: TDateTime): string; overload; + +/// +/// Transforme une heure HHMMSS dans son format d'affichage HH:MM:SS +/// +function Time6ToString(Const Time6AAfficher: string): string; + +/// +/// Transforme la date et heure du moment en AAAAMMJJHHMMSS +/// Ce format est utilisé dans le stockage d'infos de création et de modification dans la base de données et permettre des tris chronologiques sur l'ordre alphabétique. +/// +function DateTimeToString14: string; overload; + +/// +/// Transforme la date et heure passée en AAAAMMJJHHMMSS +/// Ce format est utilisé dans le stockage d'infos de création et de modification dans la base de données et permettre des tris chronologiques sur l'ordre alphabétique. +/// +function DateTimeToString14(Const ADateTime: TDateTime): string; overload; + +/// +/// Converti une valeur en secondes vers son équivalent en HMS +/// +function SecToHMS(Const Valeur_En_secondes: Integer): String; overload; +procedure SecToHMS(Const Valeur_En_secondes: Integer; + var HH, MM, SS: Integer); overload; + +/// +/// Converti une valeur HMS (xxH xxM xxS) en son équivalent en secondes +/// +function HMSToSec(Const Valeur_En_HMS: String): Integer; overload; +function HMSToSec(Const HH, MM, SS: Integer): Integer; overload; + +implementation + +uses + System.SysUtils, + System.StrUtils, + System.Character; + +function DateToString8: string; +begin + Result := DateToString8(Now); +end; + +function DateToString8(Const ADate: TDateTime): string; +begin + Result := FormatDateTime('yyyymmdd', ADate); +end; + +function Date8ToDate(Const Date8: string): tdate; +begin + Result := EncodeDate(Date8.Substring(0, 4).tointeger, + Date8.Substring(4, 2).tointeger, Date8.Substring(6, 2).tointeger); +end; + +function Date8ToString(Const Date8AAfficher: string): string; +var + MM, jj: string; +begin + // TODO : gérer les formats de date non européens de l'ouest + MM := Date8AAfficher.Substring(4, 2); + jj := Date8AAfficher.Substring(6, 2); + if MM = '00' then + Result := Date8AAfficher.Substring(0, 4) + else if jj = '00' then + Result := MM + FormatSettings.DateSeparator + Date8AAfficher.Substring(0, 4) + else + Result := jj + FormatSettings.DateSeparator + MM + + FormatSettings.DateSeparator + Date8AAfficher.Substring(0, 4); +end; + +function Date8ToStringISO(Const Date8AAfficher: string): string; +var + MM, jj: string; +begin + // TODO : gérer les formats de date non européens de l'ouest + MM := Date8AAfficher.Substring(4, 2); + jj := Date8AAfficher.Substring(6, 2); + if MM = '00' then + Result := Date8AAfficher.Substring(0, 4) + '-00-00' + else if jj = '00' then + Result := Date8AAfficher.Substring(0, 4) + '-' + MM + '-00' + else + Result := Date8AAfficher.Substring(0, 4) + '-' + MM + '-' + jj; +end; + +function Date8ToStringRFC822(Const Date8AAfficher: string): string; +var + x: Integer; +begin + if Date8AAfficher.IsEmpty then + raise Exception.Create + ('Date non renseignée. Impossible à convertir dans Date8ToStringRFC822.'); + x := Date8AAfficher.Substring(6, 2).tointeger; + if x < 1 then + x := 1; + Result := x.ToString + ' '; + case Date8AAfficher.Substring(4, 2).tointeger of + 0, 1: + Result := Result + 'Jan'; + 2: + Result := Result + 'Feb'; + 3: + Result := Result + 'Mar'; + 4: + Result := Result + 'Apr'; + 5: + Result := Result + 'May'; + 6: + Result := Result + 'Jun'; + 7: + Result := Result + 'Jul'; + 8: + Result := Result + 'Aug'; + 9: + Result := Result + 'Sep'; + 10: + Result := Result + 'Oct'; + 11: + Result := Result + 'Nov'; + 12: + Result := Result + 'Dec'; + end; + Result := Result + ' ' + Date8AAfficher.Substring(0, 4) + ' 00:00:00 GMT'; +end; + +function TimeToString6: string; +begin + Result := TimeToString6(Now); +end; + +function TimeToString6(Const ATime: TDateTime): string; +begin + Result := FormatDateTime('hhnnss', ATime); +end; + +function Time6ToString(Const Time6AAfficher: string): string; +begin + Result := Time6AAfficher.Substring(0, 2) + FormatSettings.TimeSeparator + + Time6AAfficher.Substring(2, 2) + FormatSettings.TimeSeparator + + Time6AAfficher.Substring(4, 2); +end; + +function DateTimeToString14: string; +begin + Result := DateTimeToString14(Now); +end; + +function DateTimeToString14(Const ADateTime: TDateTime): string; +begin + Result := DateToString8(ADateTime) + TimeToString6(ADateTime); +end; + +function SecToHMS(Const Valeur_En_secondes: Integer): String; +var + h, m, s: Integer; +begin + SecToHMS(Valeur_En_secondes, h, m, s); + Result := ''; + if (h > 0) then + Result := Result + h.ToString + 'H '; + if (m > 0) then + Result := Result + m.ToString + 'M '; + if (s > 0) or (Valeur_En_secondes = 0) then + Result := Result + s.ToString + 'S '; +end; + +procedure SecToHMS(Const Valeur_En_secondes: Integer; var HH, MM, SS: Integer); +begin + SS := Valeur_En_secondes; + HH := SS div SecsPerHour; + SS := SS - HH * SecsPerHour; + MM := SS div SecsPerMin; + SS := SS - MM * SecsPerMin; +end; + +function HMSToSec(Const Valeur_En_HMS: String): Integer; +var + ch: string; + i: Integer; +begin + Result := 0; + ch := Valeur_En_HMS.Trim.Replace(' ', '').ToUpper; + i := ch.IndexOf('H'); + if (i > 0) then + begin + Result := Result + ch.Substring(0, i).tointeger * SecsPerHour; + ch := ch.Substring(i + 1); + end; + i := ch.IndexOf('M'); + if (i > 0) then + begin + Result := Result + ch.Substring(0, i).tointeger * SecsPerMin; + ch := ch.Substring(i + 1); + end; + i := ch.IndexOf('S'); + if (i > 0) then + Result := Result + ch.Substring(0, i).tointeger; +end; + +function HMSToSec(Const HH, MM, SS: Integer): Integer; +begin + Result := HH * SecsPerHour + MM * SecsPerMin + SS; +end; + +end. diff --git a/src/Olf.RTL.Language.pas b/src/Olf.RTL.Language.pas new file mode 100644 index 0000000..6adcfa1 --- /dev/null +++ b/src/Olf.RTL.Language.pas @@ -0,0 +1,88 @@ +unit Olf.RTL.Language; + +// (c) Patrick Prémartin 02/2023 +// +// This file is distributed under AGPL license. +// +// Get the latest version at +// https://github.com/DeveloppeurPascal/librairies + +interface + +/// +/// Get current language code (like "fr-fr" or "en-gb") +/// The result is lower cased. +/// +function GetCurrentLanguageCode: String; + +/// +/// Get current language ISO code (like "fr" or "en") +/// This function returns first 2 letters of GetcurrentLanguageCode. +/// The result is lower cased. +/// +function GetCurrentLanguageISOCode: String; + +implementation + +// Created from this forum posts : +// https://forums.embarcadero.com/thread.jspa?threadID=108333 +// http://www.synaptica.info/en/2015/12/21/delphi-10seattle-get-current-device-language/ +// http://codeverge.com/embarcadero.delphi.firemonkey/detect-current-language-on-andr/2001235#sthash.zjLIi2KY.dpuf + +{$IF Defined(MSWINDOWS)} + +uses Winapi.Windows, System.SysUtils; +{$ELSEIF Defined(IOS)} + +uses MacAPI.ObjectiveC, iOSapi.Foundation, System.SysUtils; +{$ELSEIF Defined(MACOS)} + +uses MacAPI.ObjectiveC, MacAPI.Foundation, System.SysUtils; +{$ELSE} + +// Android + Linux +uses FMX.Platform, System.SysUtils; +{$ENDIF} + +function GetCurrentLanguageCode: String; +{$IF Defined(MSWINDOWS)} +var + buffer: PWideChar; + UserLCID: LCID; + BufLen: Integer; +begin + // defaults + UserLCID := GetUserDefaultLCID; + BufLen := GetLocaleInfo(UserLCID, LOCALE_SISO639LANGNAME, nil, 0); + buffer := StrAlloc(BufLen); + if GetLocaleInfo(UserLCID, LOCALE_SISO639LANGNAME, buffer, BufLen) <> 0 then + Result := lowercase(buffer) + else + Result := 'en'; + StrDispose(buffer); +end; +{$ELSEIF Defined(MACOS) or Defined(IOS)} + +var + Languages: NSArray; +begin + Languages := TNSLocale.OCClass.preferredLanguages; + Result := lowercase(TNSString.Wrap(Languages.objectAtIndex(0)).UTF8String); +end; +{$ELSE} + +var + LocServ: IFMXLocaleService; +begin + if TPlatformServices.Current.SupportsPlatformService(IFMXLocaleService, + IInterface(LocServ)) then + Result := LocServ.GetCurrentLangID; +end; +{$ENDIF} + +function GetCurrentLanguageISOCode: String; +begin + Result := GetCurrentLanguageCode.Substring(0, 2); +end; + +end. diff --git a/src/Olf.RTL.Params.pas b/src/Olf.RTL.Params.pas new file mode 100644 index 0000000..3d7504b --- /dev/null +++ b/src/Olf.RTL.Params.pas @@ -0,0 +1,811 @@ +unit Olf.RTL.Params; + +{ + Gestion automatisée d'un fichier de stockage sous forme de dictionnaire de + données (clé / valeur) pour les logiciels développés sous Delphi. + + Logiciel open source distribué sous licence MIT. + Open source software distributed under the MIT license + + Copyright Patrick Prémartin / Olf Software + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + SOFTWARE. + + Find the original source code on + https://github.com/DeveloppeurPascal/librairies + + Find explanations on + https://developpeur-pascal.fr/plutot-ini-ou-json-pour-stocker-vos-parametres.html + + Liste des mises à jour : + => 11/05/2020, Patrick Prémartin : + * ajout de la notice de copyright et licence d'utilisation + * gestion de données de types Syngle et TDataTime + * correction d'une perte de mémoire au niveau du remplacement d'une valeur sur un paramètre existant + => 22/04/2022, Patrick PRémartin : + * ajout de la procédure setFolderName() pour permettre la modification du dossier de stockage du fichier de paramètres + => 19/05/2022, Patrick Prémartin : + * creation de Olf.RTL.Params à partir de uParam + * ajout de la fonction ToJSON permettant d'obtenir la représentation du fichier de stockage sous forme de chaîne JSON + * ajout de la fonction AsJSONObject pour obtenir la représentation sous forme de TJSONObject des paramètres + * ajout de la fonction getFilePath pour obtenir le nom du fichier de stockage avec son chemin d'accès (attention : ne le modifiez pas en direct si vous utilisez aussi la classe TParams dans votre projet) + * ajout de la procédure setFilePath() pour définir le chemin et le nom du fichier de stockage des paramètres + * ajout de valeurs par défaut pour la valeur par défaut dans les fonctions getValue() + * ajout des commentaires XMLDoc + * ajout de la classe TParamsFile pour rendre possible la manipulation de plusieurs fichiers de paramètres si on en a besoin + * ajout de MoveToFilePath() pour déplacer le fichier de paramètres actuel + * ajout de setValue et getValue pour des TJSONValue et ses descendants + => 31/12/2023, Patrick Prémartin : + * ajout d'une variante "cardinal" du getValue() et SetValue() +} +interface + +uses + System.JSON; + +type + TParamsFile = class(TObject) + private + FParamChanged: boolean; + FParamList: TJSONObject; + FFolderName: string; + FFileName: string; + protected + function getParamsFileName(ACreateFolder: boolean = False): string; + function getParamValue(key: string): TJSONValue; + procedure setParamValue(key: string; value: TJSONValue); + public + /// + /// Class constructor wich just initialize private fields. + /// + constructor Create; overload; + /// + /// Class constructor wich loads the parameter file specified as parameter. + /// + /// + /// Absolute file path to the parameter file (drive+folder+file name+extension) + /// + constructor Create(AFilePath: string); overload; + /// + /// Instance destructor + /// + destructor Destroy; override; + /// + /// Save current parameters to actual parameter file + /// + procedure Save; + /// + /// Load parameters from actual parameter file + /// + procedure Load; + /// + /// Cancel current changes and reload previous saved values + /// + procedure Cancel; + /// + /// Get the string value for key parameter with an empty string as default value + /// + function getValue(key: string; default: string = ''): string; overload; + /// + /// Get the boolean value for key parameter with False as default value + /// + function getValue(key: string; default: boolean = False): boolean; overload; + /// + /// Get the cardinal value for key parameter with zero as default value + /// + function getValue(key: string; default: cardinal = 0): cardinal; overload; + /// + /// Get the integer value for key parameter with zero as default value + /// + function getValue(key: string; default: integer = 0): integer; overload; + /// + /// Get the single value for key parameter with zero as default value + /// + function getValue(key: string; default: single = 0): single; overload; + /// + /// Get the TDateTime value for key parameter with December 30th 1899 at 12:00 as default value + /// + function getValue(key: string; default: TDateTime = 0): TDateTime; overload; + /// + /// Get the JSON value for key parameter with nil as default value + /// + function getValue(key: string; default: TJSONValue = nil) + : TJSONValue; overload; + /// + /// Set the value for key parameter as string + /// + procedure setValue(key, value: string); overload; + /// + /// Set the value for key parameter as boolean + /// + procedure setValue(key: string; value: boolean); overload; + /// + /// Set the value for key parameter as cardinal + /// + procedure setValue(key: string; value: cardinal); overload; + /// + /// Set the value for key parameter as integer + /// + procedure setValue(key: string; value: integer); overload; + /// + /// Set the value for key parameter as single + /// + procedure setValue(key: string; value: single); overload; + /// + /// Set the value for key parameter as TDateTime + /// + procedure setValue(key: string; value: TDateTime); overload; + /// + /// Set the value for key parameter as TJSONValue + /// + procedure setValue(key: string; value: TJSONValue); overload; + /// + /// Change the folder where is the parameter file. + /// + /// + /// Absolute folder path where you want to save the parameter file. + /// + /// + /// If set to True (by default), call the Load procedure after changing the folder. + /// + /// + /// To change the file name, use setFilePath() instead of setFolderName(). + /// + procedure setFolderName(AFolderName: string; AReload: boolean = true); + /// + /// Change the folder where is the parameter file. + /// + /// + /// Absolute file path (drive+folder+file name+extension) to the parameter file you want to use. + /// + /// + /// If set to True (by default), call Load procedure after changing the file path. + /// + /// + /// If you only want to change the path to the parameter file, use setFolderName procedure instead of this one. + /// + procedure setFilePath(AFilePath: string; AReload: boolean = true); + /// + /// Move actual parameter file to the new file. + /// + /// + /// Absolute file path (drive+folder+file name+extension) to the parameter file you want to use. + /// + /// + /// If set to True, save actual values to the parameter file. + /// If set to false, just move the parameter file to it's new folder/filename. + /// + /// + /// If set to True, create the folder of file parameter if it doesn't exists. + /// + procedure MoveToFilePath(ANewFilePath: string; ASave: boolean = true; + ACreateFolder: boolean = False); + /// + /// Return the absolute path to the parameter file (drive+folder+file name+extension) + /// + function getFilePath: string; + /// + /// Return the current parameters as a serialized JSON object. + /// + function ToJSON: string; + /// + /// Return the current parameters as a JSON object + /// + /// + /// If set to True (by default), the result is a clone of actual object. Free it when you have finished to work with it or you'll have memory leaks in your projects. + /// If set to False, the result is a reference to the internal JSON object. All changes are made to it. Don't destroy it or you'll have Access Violation exception. + /// + function AsJSONObject(AClone: boolean = true): TJSONObject; + end; + + TParams = class(TObject) + public + /// + /// Save current parameters to actual parameter file + /// + class procedure Save; + /// + /// Load parameters from actual parameter file + /// + class procedure Load; + /// + /// Get the string value for key parameter with an empty string as default value + /// + class function getValue(key: string; default: string = ''): string; + overload; + /// + /// Get the boolean value for key parameter with False as default value + /// + class function getValue(key: string; default: boolean = False) + : boolean; overload; + /// + /// Get the integer value for key parameter with zero as default value + /// + class function getValue(key: string; default: integer = 0) + : integer; overload; + /// + /// Get the cardinal value for key parameter with zero as default value + /// + class function getValue(key: string; default: cardinal = 0) + : integer; overload; + /// + /// Get the single value for key parameter with zero as default value + /// + class function getValue(key: string; default: single = 0): single; overload; + /// + /// Get the TDateTime value for key parameter with December 30th 1899 at 12:00 as default value + /// + class function getValue(key: string; default: TDateTime = 0) + : TDateTime; overload; + /// + /// Get the JSON value for key parameter with nil as default value + /// + class function getValue(key: string; default: TJSONValue = nil) + : TJSONValue; overload; + /// + /// Set the value for key parameter as string + /// + class procedure setValue(key, value: string); overload; + /// + /// Set the value for key parameter as boolean + /// + class procedure setValue(key: string; value: boolean); overload; + /// + /// Set the value for key parameter as integer + /// + class procedure setValue(key: string; value: integer); overload; + /// + /// Set the value for key parameter as cardinal + /// + class procedure setValue(key: string; value: cardinal); overload; + /// + /// Set the value for key parameter as single + /// + class procedure setValue(key: string; value: single); overload; + /// + /// Set the value for key parameter as TDateTime + /// + class procedure setValue(key: string; value: TDateTime); overload; + /// + /// Set the value for key parameter as TJSONValue + /// + class procedure setValue(key: string; value: TJSONValue); overload; + /// + /// Change the folder where is the parameter file. + /// + /// + /// Absolute folder path where you want to save the parameter file. + /// + /// + /// If set to True (by default), call the Load procedure after changing the folder. + /// + /// + /// To change the file name, use setFilePath() instead of setFolderName(). + /// + class procedure setFolderName(AFolderName: string; AReload: boolean = true); + /// + /// Change the folder where is the parameter file. + /// + /// + /// Absolute file path (drive+folder+file name+extension) to the parameter file you want to use. + /// + /// + /// If set to True (by default), call Load procedure after changing the file path. + /// + /// + /// If you only want to change the path to the parameter file, use setFolderName procedure instead of this one. + /// + class procedure setFilePath(AFilePath: string; AReload: boolean = true); + /// + /// Move actual parameter file to the new file. + /// + /// + /// Absolute file path (drive+folder+file name+extension) to the parameter file you want to use. + /// + /// + /// If set to True, save actual values to the parameter file. + /// If set to false, just move the parameter file to it's new folder/filename. + /// + /// + /// If set to True, create the folder of file parameter if it doesn't exists. + /// + class procedure MoveToFilePath(ANewFilePath: string; ASave: boolean = true; + ACreateFolder: boolean = False); + /// + /// Return the absolute path to the parameter file (drive+folder+file name+extension) + /// + class function getFilePath: string; + /// + /// Return the current parameters as a serialized JSON object. + /// + class function ToJSON: string; + /// + /// Return the current parameters as a JSON object + /// + class function AsJSONObject: TJSONObject; + end; + +implementation + +uses + System.Generics.collections, System.IOUtils, System.SysUtils, System.Classes; + +{ TParamsFile } + +function TParamsFile.getParamsFileName(ACreateFolder: boolean = False): string; +var + folder: string; + filename: string; + app_name: string; +begin + app_name := TPath.GetFileNameWithoutExtension(paramstr(0)); + + // get filename + if FFileName.IsEmpty then + begin +{$IF Defined(DEBUG)} + filename := app_name + '-debug.par'; +{$ELSE if Defined(RELEASE)} + filename := app_name + '.par'; +{$ELSE} +{$MESSAGE FATAL 'setup problem'} +{$ENDIF} end + else + filename := FFileName; + + // get folder name + if FFolderName.IsEmpty then + folder := TPath.Combine(TPath.GetDocumentsPath, app_name) + else + folder := FFolderName; + if ACreateFolder and (not tdirectory.Exists(folder)) then + tdirectory.CreateDirectory(folder); + + // get file path + result := TPath.Combine(folder, filename); +end; + +function TParamsFile.getParamValue(key: string): TJSONValue; +begin + result := nil; + if assigned(FParamList) then + if (FParamList.Count > 0) then + result := FParamList.getValue(key); +end; + +procedure TParamsFile.setParamValue(key: string; value: TJSONValue); +begin + if not assigned(FParamList) then + FParamList := TJSONObject.Create + else if (FParamList.Count > 0) and (nil <> FParamList.getValue(key)) then + FParamList.RemovePair(key).Free; + FParamList.AddPair(key, value); + FParamChanged := true; +end; + +procedure TParamsFile.setValue(key: string; value: cardinal); +var + jsonvalue: TJSONNumber; +begin + jsonvalue := TJSONNumber.Create(value); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +function TParamsFile.getValue(key: string; default: boolean): boolean; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := jsonvalue.value.ToBoolean + else + result := default; +end; + +function TParamsFile.getValue(key: string; default: string): string; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := jsonvalue.value + else + result := default; +end; + +function TParamsFile.getValue(key: string; default: integer): integer; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := jsonvalue.value.ToInteger + else + result := default; +end; + +function TParamsFile.getValue(key: string; default: single): single; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := jsonvalue.value.ToSingle + else + result := default; +end; + +function TParamsFile.AsJSONObject(AClone: boolean): TJSONObject; +begin + if not assigned(FParamList) then + result := nil + else if AClone then + result := FParamList.Clone as TJSONObject + else + result := FParamList; +end; + +constructor TParamsFile.Create; +begin + FFolderName := ''; + FParamChanged := False; + FParamList := TJSONObject.Create; +end; + +procedure TParamsFile.Cancel; +begin + Load; +end; + +constructor TParamsFile.Create(AFilePath: string); +begin + Create; + setFilePath(AFilePath, true); +end; + +destructor TParamsFile.Destroy; +begin + Save; + if assigned(FParamList) then + FreeAndNil(FParamList); + inherited; +end; + +function TParamsFile.getFilePath: string; +begin + result := getParamsFileName; +end; + +function TParamsFile.getValue(key: string; default: TDateTime): TDateTime; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := strToDateTime(jsonvalue.value) + else + result := default; +end; + +procedure TParamsFile.Load; +var + filename: string; + buffer: tStringStream; +begin + filename := getParamsFileName; + if tfile.Exists(filename) then + begin + if assigned(FParamList) then + FreeAndNil(FParamList); + buffer := tStringStream.Create(tfile.ReadAllText(filename, TEncoding.UTF8), + TEncoding.UTF8); + try + FParamList := TJSONObject.Create; + FParamList.Parse(buffer.Bytes, 0); + finally + buffer.Free; + end; + end; +end; + +procedure TParamsFile.MoveToFilePath(ANewFilePath: string; ASave: boolean; + ACreateFolder: boolean); +var + oldFilePath: string; + NewPath: string; +begin + oldFilePath := getFilePath; + if (oldFilePath <> ANewFilePath) then + begin + NewPath := TPath.GetDirectoryName(ANewFilePath); + if not tdirectory.Exists(NewPath) then + if ACreateFolder then + tdirectory.CreateDirectory(NewPath) + else + raise Exception.Create('Folder "' + NewPath + '" doesn''t exist.'); + tfile.Move(oldFilePath, ANewFilePath); + setFilePath(ANewFilePath, False); + if ASave then + Save; + end; +end; + +procedure TParamsFile.Save; +var + filename: string; +begin + if (FParamChanged) then + begin + filename := getParamsFileName(true); + if assigned(FParamList) and (FParamList.Count > 0) then + tfile.WriteAllText(filename, FParamList.ToJSON, TEncoding.UTF8) + else if tfile.Exists(filename) then + tfile.Delete(filename); + FParamChanged := False; + end; +end; + +procedure TParamsFile.setValue(key: string; value: single); +var + jsonvalue: TJSONNumber; +begin + jsonvalue := TJSONNumber.Create(value); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +procedure TParamsFile.setValue(key: string; value: TDateTime); +var + jsonvalue: TJSONString; +begin + jsonvalue := TJSONString.Create(DateTimeToStr(value)); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +function TParamsFile.ToJSON: string; +begin + if assigned(FParamList) then + result := FParamList.ToJSON + else + result := ''; +end; + +procedure TParamsFile.setValue(key, value: string); +var + jsonvalue: TJSONString; +begin + jsonvalue := TJSONString.Create(value); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +procedure TParamsFile.setValue(key: string; value: boolean); +var + jsonvalue: TJSONBool; +begin + jsonvalue := TJSONBool.Create(value); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +procedure TParamsFile.setValue(key: string; value: integer); +var + jsonvalue: TJSONNumber; +begin + jsonvalue := TJSONNumber.Create(value); + try + setParamValue(key, jsonvalue); + except + jsonvalue.Free; + end; +end; + +procedure TParamsFile.setFilePath(AFilePath: string; AReload: boolean); +begin + if AFilePath.IsEmpty then + begin + FFolderName := ''; + FFileName := ''; + end + else + begin + FFolderName := TPath.GetDirectoryName(AFilePath); + if not tdirectory.Exists(FFolderName) then + raise Exception.Create('Folder "' + FFolderName + '" doesn''t exist.'); + FFileName := TPath.GetFileName(AFilePath); + end; + if AReload then + Load; +end; + +procedure TParamsFile.setFolderName(AFolderName: string; AReload: boolean); +begin + FFolderName := AFolderName; + if AReload then + Load; +end; + +function TParamsFile.getValue(key: string; default: TJSONValue): TJSONValue; +begin + result := getParamValue(key); + if not assigned(result) then + result := default; +end; + +function TParamsFile.getValue(key: string; default: cardinal): cardinal; +var + jsonvalue: TJSONValue; +begin + jsonvalue := getParamValue(key); + if assigned(jsonvalue) then + result := jsonvalue.value.ToInt64 + else + result := default; +end; + +procedure TParamsFile.setValue(key: string; value: TJSONValue); +begin + setParamValue(key, value); +end; + +{ TParams } + +var + DefaultParamsFile: TParamsFile; + +class function TParams.AsJSONObject: TJSONObject; +begin + result := DefaultParamsFile.AsJSONObject(true); +end; + +class function TParams.getFilePath: string; +begin + result := DefaultParamsFile.getFilePath; +end; + +class function TParams.getValue(key: string; default: integer): integer; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class function TParams.getValue(key: string; default: boolean): boolean; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class function TParams.getValue(key, default: string): string; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class function TParams.getValue(key: string; default: single): single; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class function TParams.getValue(key: string; default: TDateTime): TDateTime; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class procedure TParams.Load; +begin + DefaultParamsFile.Load; +end; + +class procedure TParams.MoveToFilePath(ANewFilePath: string; ASave: boolean; + ACreateFolder: boolean); +begin + DefaultParamsFile.MoveToFilePath(ANewFilePath, ASave, ACreateFolder); +end; + +class procedure TParams.Save; +begin + DefaultParamsFile.Save; +end; + +class procedure TParams.setFilePath(AFilePath: string; AReload: boolean); +begin + DefaultParamsFile.setFilePath(AFilePath, AReload); +end; + +class procedure TParams.setFolderName(AFolderName: string; AReload: boolean); +begin + DefaultParamsFile.setFolderName(AFolderName, AReload); +end; + +class procedure TParams.setValue(key: string; value: boolean); +begin + DefaultParamsFile.setValue(key, value); +end; + +class procedure TParams.setValue(key, value: string); +begin + DefaultParamsFile.setValue(key, value); +end; + +class procedure TParams.setValue(key: string; value: TDateTime); +begin + DefaultParamsFile.setValue(key, value); +end; + +class procedure TParams.setValue(key: string; value: single); +begin + DefaultParamsFile.setValue(key, value); +end; + +class procedure TParams.setValue(key: string; value: integer); +begin + DefaultParamsFile.setValue(key, value); +end; + +class function TParams.ToJSON: string; +begin + result := DefaultParamsFile.ToJSON; +end; + +class function TParams.getValue(key: string; default: TJSONValue): TJSONValue; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class function TParams.getValue(key: string; default: cardinal): integer; +begin + result := DefaultParamsFile.getValue(key, default); +end; + +class procedure TParams.setValue(key: string; value: TJSONValue); +begin + DefaultParamsFile.setValue(key, value); +end; + +class procedure TParams.setValue(key: string; value: cardinal); +begin + DefaultParamsFile.setValue(key, value); +end; + +initialization + +DefaultParamsFile := TParamsFile.Create; +TParams.Load; + +finalization + +TParams.Save; +if assigned(DefaultParamsFile) then + FreeAndNil(DefaultParamsFile); + +end. diff --git a/src/Olf.RTL.Streams.pas b/src/Olf.RTL.Streams.pas new file mode 100644 index 0000000..16009cb --- /dev/null +++ b/src/Olf.RTL.Streams.pas @@ -0,0 +1,106 @@ +unit Olf.RTL.Streams; + +interface + +uses + System.SysUtils, + System.Classes; + +procedure SaveStringToStream(AString: string; AStream: TStream); overload; +procedure SaveStringToStream(AString: string; AStream: TStream; + AEncoding: TEncoding); overload; + +function LoadStringFromStream(AStream: TStream): string; overload; +function LoadStringFromStream(AStream: TStream; AEncoding: TEncoding) + : string; overload; + +function LoadSubStreamFromStream(const AFromStream, AToSubStream + : TStream): boolean; +procedure SaveSubStreamToStream(const AFromSubStream, AToStream: TStream); + +implementation + +procedure SaveStringToStream(AString: string; AStream: TStream); +begin + SaveStringToStream(AString, AStream, TEncoding.UTF8); +end; + +procedure SaveStringToStream(AString: string; AStream: TStream; + AEncoding: TEncoding); +var + StrLen: int64; // typeof(System.Classes.TStream.size) + StrStream: TStringStream; +begin + StrStream := TStringStream.Create(AString, AEncoding); + try + StrLen := StrStream.Size; + AStream.write(StrLen, sizeof(StrLen)); + if (StrLen > 0) then + begin + StrStream.Position := 0; + AStream.CopyFrom(StrStream); + end; + finally + StrStream.Free; + end; +end; + +function LoadStringFromStream(AStream: TStream): string; +begin + Result := LoadStringFromStream(AStream, TEncoding.UTF8); +end; + +function LoadStringFromStream(AStream: TStream; AEncoding: TEncoding): string; +var + StrLen: int64; // typeof(System.Classes.TStream.size) + StrStream: TStringStream; +begin + AStream.Read(StrLen, sizeof(StrLen)); + if (StrLen > 0) then + begin + StrStream := TStringStream.Create('', AEncoding); + try + StrStream.CopyFrom(AStream, StrLen); + Result := StrStream.DataString; + finally + StrStream.Free; + end; + end + else + Result := ''; +end; + +function LoadSubStreamFromStream(const AFromStream, AToSubStream + : TStream): boolean; +var + Size: int64; +begin + if not assigned(AFromStream) then + raise exception.Create('Need a FromStream instance !'); + if not assigned(AToSubStream) then + raise exception.Create('Need a ToStream instance !'); + + Result := (AFromStream.ReadData(Size) = sizeof(Size)); + if Result then + AToSubStream.CopyFrom(AFromStream, Size); +end; + +procedure SaveSubStreamToStream(const AFromSubStream, AToStream: TStream); +var + Size: int64; +begin + if not assigned(AFromSubStream) then + raise exception.Create('Need a FromStream instance !'); + if not assigned(AToStream) then + raise exception.Create('Need a ToStream instance !'); + + Size := AFromSubStream.Size; + AToStream.WriteData(Size); + if (Size > 0) then + begin + AFromSubStream.Position := 0; + AToStream.CopyFrom(AFromSubStream, Size); + end; +end; + +end. diff --git a/src/Olf.RTL.SystemAppearance.pas b/src/Olf.RTL.SystemAppearance.pas new file mode 100644 index 0000000..d10c58c --- /dev/null +++ b/src/Olf.RTL.SystemAppearance.pas @@ -0,0 +1,102 @@ +unit Olf.RTL.SystemAppearance; + +interface + +function isSystemThemeInLightMode: boolean; +function isSystemThemeInDarkMode: boolean; + +implementation + +{$IF NOT Defined(MSWINDOWS)} + +uses + FMX.Platform; +{$ELSE} +// TODO : intercepter le changement de couleur du système et le signaler sous forme de message à l'application en cours + +uses + winapi.Windows, + System.Win.Registry; + +const + CRegKey = 'Software\Microsoft\Windows\CurrentVersion\Themes\Personalize'; + CRegValueApps = 'AppsUseLightTheme'; + CRegValueSystem = 'SystemUsesLightTheme'; +{$ENDIF} + +function isSystemThemeInLightMode: boolean; +{$IF NOT Defined(MSWINDOWS)} +var + InfoScreen: IFMXSystemAppearanceService; +{$ELSE} +var + reg: TRegistry; +{$ENDIF} +begin +{$IF NOT Defined(MSWINDOWS)} + if TPlatformServices.Current.SupportsPlatformService + (IFMXSystemAppearanceService, InfoScreen) then + result := (InfoScreen.ThemeKind = TSystemThemeKind.Light) + else + result := true; +{$ELSE} + // inspired by unit WindowsDarkMode.pas from Ian Barker at https://github.com/checkdigits/delphidarkmode + reg := TRegistry.Create(KEY_READ); + try + reg.RootKey := HKEY_CURRENT_USER; + if reg.KeyExists(CRegKey) and reg.OpenKey(CRegKey, False) then + try + if reg.ValueExists(CRegValueApps) then + result := reg.ReadInteger(CRegValueApps) = 1 + else if reg.ValueExists(CRegValueSystem) then + result := reg.ReadInteger(CRegValueApps) = 1 + else + result := true; + finally + reg.CloseKey; + end + else + result := true; + finally + reg.Free; + end; +{$ENDIF} +end; + +function isSystemThemeInDarkMode: boolean; +{$IF NOT Defined(MSWINDOWS)} +var + InfoScreen: IFMXSystemAppearanceService; +{$ELSE} +var + reg: TRegistry; +{$ENDIF} +begin +{$IF NOT Defined(MSWINDOWS)} + result := TPlatformServices.Current.SupportsPlatformService + (IFMXSystemAppearanceService, InfoScreen) and + (InfoScreen.ThemeKind = TSystemThemeKind.Dark); +{$ELSE} + reg := TRegistry.Create(KEY_READ); + try + reg.RootKey := HKEY_CURRENT_USER; + if reg.KeyExists(CRegKey) and reg.OpenKey(CRegKey, False) then + try + if reg.ValueExists(CRegValueApps) then + result := reg.ReadInteger(CRegValueApps) = 0 + else if reg.ValueExists(CRegValueSystem) then + result := reg.ReadInteger(CRegValueApps) = 0 + else + result := False; + finally + reg.CloseKey; + end + else + result := False; + finally + reg.Free; + end; +{$ENDIF} +end; + +end. diff --git a/src/Olf.VCL.Streams.pas b/src/Olf.VCL.Streams.pas new file mode 100644 index 0000000..7897aa3 --- /dev/null +++ b/src/Olf.VCL.Streams.pas @@ -0,0 +1,72 @@ +unit Olf.VCL.Streams; + +interface + +uses + VCL.Graphics, + System.SysUtils, + System.Classes; + +procedure SaveBitmapToStream(ABitmap: TBitmap; AToStream: TStream); +function LoadBitmapFromStream(AFromStream: TStream): TBitmap; + +implementation + +procedure SaveBitmapToStream(ABitmap: TBitmap; AToStream: TStream); +var + ms: TMemoryStream; + size: int64; +begin + if not assigned(AToStream) then + raise exception.create('Need an existing stream to save the bitmap !'); + + if not assigned(ABitmap) then + begin + size := 0; + AToStream.WriteData(size); + end + else + begin + ms := TMemoryStream.create; + try + ABitmap.SaveToStream(ms); + size := ms.size; + AToStream.WriteData(size); + if (size > 0) then + begin + ms.Position := 0; + AToStream.CopyFrom(ms, size); + end; + finally + ms.free; + end; + end; +end; + +function LoadBitmapFromStream(AFromStream: TStream): TBitmap; +var + ms: TMemoryStream; + size: int64; +begin + if not assigned(AFromStream) then + raise exception.create('Need an existing stream to load the bitmap !'); + + if (AFromStream.ReadData(size) <> sizeof(size)) then + result := nil + else if (size < 1) then + result := nil + else + begin + ms := TMemoryStream.create; + try + ms.CopyFrom(AFromStream, size); + ms.Position := 0; + result := TBitmap.create; + result.LoadFromStream(ms); + finally + ms.free; + end; + end; +end; + +end. \ No newline at end of file diff --git a/src/OlfSoftware_XML.dof b/src/OlfSoftware_XML.dof new file mode 100644 index 0000000..33600e0 --- /dev/null +++ b/src/OlfSoftware_XML.dof @@ -0,0 +1,89 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=0 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=XML Components from Olf Software +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=$(DELPHI)\Lib\Debug +Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;ibevnt50;vcldbx50;TeeUI50;TeeDB50;Tee50;TeeQR50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50 +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang=$0000040C +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=1 +MajorVer=1 +MinorVer=0 +Release=0 +Build=2 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 +[Version Info Keys] +CompanyName=Netbusiness +FileDescription= +FileVersion=1.0.0.2 +InternalName= +LegalCopyright=Netbusiness 2001 +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +c:\program files\borland\delphi6\Projects\Bpl\OlfSoftware_XML.bpl=XML Components from Olf Software diff --git a/src/OlfSoftware_XML.dpk b/src/OlfSoftware_XML.dpk new file mode 100644 index 0000000..c60f14b --- /dev/null +++ b/src/OlfSoftware_XML.dpk @@ -0,0 +1,35 @@ +package OlfSoftware_XML; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'XML Components from Olf Software'} +{$IMPLICITBUILD OFF} + +requires + vcl, + microsoft_xml; + +contains + XML_as_List in 'XML_as_List.pas'; + +end. diff --git a/src/XML_as_List.pas b/src/XML_as_List.pas new file mode 100644 index 0000000..dc9645d --- /dev/null +++ b/src/XML_as_List.pas @@ -0,0 +1,166 @@ +unit XML_as_List; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MSXML_TLB; + +type + TXML_as_List = class(TComponent) + private + { Déclarations privées } + fActive: Boolean; + fFileName: WideString; + fDocument: TDOMDocument; + fNoeud_Actuel : IXMLDOMNode; + procedure Set_Active(const Value: Boolean); + procedure Set_FileName(const Value: WideString); + protected + { Déclarations protégées } + public + { Déclarations publiques } + function Bof: boolean; + procedure Close; + constructor Create (AOwner: TComponent); override; + function Eof: boolean; + function FieldByName_AsString (FieldName: WideString): WideString; + function FieldByName_AsInteger (FieldName: WideString): Int64; + function FieldByName_AsFloat (FieldName: WideString): Extended; + procedure First; + procedure Last; + procedure Next; + function Open (FileName: WideString): boolean; + procedure Previous; + published + { Déclarations publiées } + property Active : Boolean read fActive write Set_Active default false; + property FileName : WideString read fFileName write Set_FileName; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('OlfSoftware', [TXML_as_List]); +end; + +{ TXML_as_List } + +function TXML_as_List.Bof: boolean; +begin + Result := (fNoeud_Actuel = nil); +end; + +procedure TXML_as_List.Close; +begin + Active := False; +end; + +constructor TXML_as_List.Create(AOwner: TComponent); +begin + inherited; + fDocument := TDOMDocument.Create (Self); + fNoeud_Actuel := nil; +end; + +function TXML_as_List.Eof: boolean; +begin + Result := (fNoeud_Actuel = nil); +end; + +function TXML_as_List.FieldByName_AsFloat(FieldName: WideString): Extended; +begin + try + Result := StrToFloat (FieldByName_AsString (FieldName)); + except + Result := 0; + end; +end; + +function TXML_as_List.FieldByName_AsInteger( + FieldName: WideString): Int64; +begin + try + Result := StrToInt64 (FieldByName_AsString (FieldName)); + except + Result := 0; + end; +end; + +function TXML_as_List.FieldByName_AsString( + FieldName: WideString): WideString; +var + noeud: IXMLDOMNode; +begin + if (fNoeud_Actuel <> nil) then begin + noeud := fNoeud_Actuel.firstChild; + while ((noeud <> nil) and (LowerCase (noeud.baseName) <> LowerCase (FieldName))) do + noeud := noeud.nextSibling; + {endwhile} + if (noeud <> nil) then + Result := noeud.text + else + Result := ''; + {endif} + end else + Result := ''; + {endif} +end; + +procedure TXML_as_List.First; +begin + if (fActive) then + fNoeud_Actuel := fDocument.documentElement.firstChild; + {endif} +end; + +procedure TXML_as_List.Last; +begin + if (fActive) then + fNoeud_Actuel := fDocument.documentElement.lastChild; + {endif} +end; + +procedure TXML_as_List.Next; +begin + fNoeud_Actuel := fNoeud_Actuel.nextSibling; +end; + +function TXML_as_List.Open(FileName: WideString): boolean; +begin + if fActive then + fActive := False; + {endif} + if (fDocument.load (FileName)) then begin + fFileName := FileName; + fActive := True; + First; + end; + Result := fActive; +end; + +procedure TXML_as_List.Previous; +begin + fNoeud_Actuel := fNoeud_Actuel.previousSibling; +end; + +procedure TXML_as_List.Set_Active(const Value: Boolean); +begin + if (Value <> fActive) then begin + fActive := Value; + if (Value) then + Open (fFileName) + else + fNoeud_Actuel := nil; + {endif} + end; +end; + +procedure TXML_as_List.Set_FileName(const Value: WideString); +begin + fFileName := Value; +end; + +end. diff --git a/src/f_operation_en_cours.dfm b/src/f_operation_en_cours.dfm new file mode 100644 index 0000000..f923893 Binary files /dev/null and b/src/f_operation_en_cours.dfm differ diff --git a/src/f_operation_en_cours.pas b/src/f_operation_en_cours.pas new file mode 100644 index 0000000..f928e9e --- /dev/null +++ b/src/f_operation_en_cours.pas @@ -0,0 +1,91 @@ +unit f_operation_en_cours; + +interface + +uses System.Classes, Vcl.Controls, Vcl.ComCtrls; + +Procedure oec_Ouverture(nb_operation: cardinal); +Procedure oec_Operation_Suivante; +Procedure oec_Fermeture; + +implementation + +{$R *.DFM} + +uses + Windows, Messages, SysUtils, Graphics, Forms, Dialogs; + +type + Tfrm = class(TForm) + ProgressBar1: TProgressBar; + private + { Déclarations privées } + public + { Déclarations publiques } + end; + +var + frm: Tfrm; + +Procedure oec_Ouverture(nb_operation: cardinal); +begin + if (frm = nil) then + frm := Tfrm.Create(Nil); + try + frm.ProgressBar1.Min := 0; + frm.ProgressBar1.Max := nb_operation; + frm.ProgressBar1.Position := 0; + frm.Show; + except + try + frm.Free; + finally + frm := nil; + end; + end; +end; + +Procedure oec_Operation_Suivante; +begin + if (frm = nil) then + oec_Ouverture(0); + try + frm.ProgressBar1.StepIt; + except + try + frm.Free; + finally + frm := nil; + end; + end; +end; + +Procedure oec_Fermeture; +begin + if (frm = nil) then + oec_Ouverture(0); + try + frm.Hide; + except + try + frm.Free; + finally + frm := nil; + end; + end; +end; + +initialization + +frm := nil; + +finalization + +if (frm <> nil) then +begin + frm.Free; + frm := nil; +end; + +{ endif } +end. diff --git a/src/imports/AgentObjects_TLB.dcr b/src/imports/AgentObjects_TLB.dcr new file mode 100644 index 0000000..11bc6a0 Binary files /dev/null and b/src/imports/AgentObjects_TLB.dcr differ diff --git a/src/imports/AgentObjects_TLB.pas b/src/imports/AgentObjects_TLB.pas new file mode 100644 index 0000000..0f7ffb9 --- /dev/null +++ b/src/imports/AgentObjects_TLB.pas @@ -0,0 +1,1227 @@ +unit AgentObjects_TLB; + +// ************************************************************************ // +// AVERTISSEMENT +// ------- +// Les types déclarés dans ce fichier ont été générés à partir de données lues +// depuis la bibliothèque de types. Si cette dernière (via une autre bibliothèque de types +// s'y référant) est explicitement ou indirectement ré-importée, ou la commande "Rafraîchir" +// de l'éditeur de bibliothèque de types est activée lors de la modification de la bibliothèque +// de types, le contenu de ce fichier sera régénéré et toutes les modifications +// manuellement apportées seront perdues. +// ************************************************************************ // + +// PASTLWTR : $Revision: 1.88.1.0.1.0 $ +// Fichier généré le 24/07/2001 16:45:24 depuis la bibliothèque de types ci-dessous. + +// ************************************************************************ // +// Bibl.Types : C:\WINDOWS\msagent\agentctl.dll (1) +// IID\LCID : {F5BE8BC2-7DE6-11D0-91FE-00C04FD701A5}\0 +// Fichier d'aide : +// DepndLst : +// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb) +// (2) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll) +// Erreurs : +// Remarque : paramètre 'On' dans IAgentCtlCharacterEx.AutoPopupMenu changé en 'On_' +// Remarque : paramètre 'On' dans IAgentCtlCharacterEx.AutoPopupMenu changé en 'On_' +// Remarque : paramètre 'On' dans IAgentCtlCharacterEx.HelpModeOn changé en 'On_' +// Remarque : paramètre 'On' dans IAgentCtlCharacterEx.HelpModeOn changé en 'On_' +// Remarque : paramètre 'File' dans IAgentCtlCharacterEx.HelpFile changé en 'File_' +// Remarque : paramètre 'File' dans IAgentCtlCharacterEx.HelpFile changé en 'File_' +// Remarque : paramètre 'On' dans IAgentCtlCharacter.IdleOn changé en 'On_' +// Remarque : paramètre 'On' dans IAgentCtlCharacter.IdleOn changé en 'On_' +// Remarque : paramètre 'Type' dans IAgentCtlCharacter.Get changé en 'Type_' +// Remarque : paramètre 'On' dans IAgentCtlCharacter.SoundEffectsOn changé en 'On_' +// Remarque : paramètre 'On' dans IAgentCtlCharacter.SoundEffectsOn changé en 'On_' +// ************************************************************************ // +{$TYPEDADDRESS OFF} // L'unité doit être compilée sans vérification de type des pointeurs. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// GUIDS déclarés dans la bibliothèque de types. Préfixes utilisés : +// Bibliothèques de types : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces : IID_xxxx +// *********************************************************************// +const + // Version majeure et mineure de la bibliothèque de types + AgentObjectsMajorVersion = 2; + AgentObjectsMinorVersion = 0; + + LIBID_AgentObjects: TGUID = '{F5BE8BC2-7DE6-11D0-91FE-00C04FD701A5}'; + + IID_IAgentCtlCharacters: TGUID = '{F5BE8BE8-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlCharacter: TGUID = '{F5BE8BD9-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlCharacterEx: TGUID = '{DE8EF600-2F82-11D1-ACAC-00C04FD97575}'; + IID_IAgentCtlBalloon: TGUID = '{F5BE8BD3-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlBalloonEx: TGUID = '{822DB1C0-8879-11D1-9EC6-00C04FD7081F}'; + IID_IAgentCtlCommands: TGUID = '{F5BE8BE1-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlCommandsEx: TGUID = '{6BA90C01-3910-11D1-ACB3-00C04FD97575}'; + IID_IAgentCtlCommand: TGUID = '{F5BE8BE3-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlCommandEx: TGUID = '{B0913410-3B44-11D1-ACBA-00C04FD97575}'; + IID_IAgentCtlRequest: TGUID = '{1DAB85C3-803A-11D0-AC63-00C04FD97575}'; + IID_IAgentCtlAnimationNames: TGUID = '{8B77181C-D3EF-11D1-8500-00C04FA34A14}'; + IID_IAgentCtlAudioObject: TGUID = '{F5BE8BDB-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlAudioObjectEx: TGUID = '{F5BE8BF0-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlSpeechInput: TGUID = '{F5BE8BDD-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlPropertySheet: TGUID = '{F5BE8BDF-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlUserInput: TGUID = '{C4ABF875-8100-11D0-AC63-00C04FD97575}'; + IID_IAgentCtlCommandsWindow: TGUID = '{6D0ECB27-9968-11D0-AC6E-00C04FD97575}'; + IID_IAgentCtl: TGUID = '{F5BE8BD1-7DE6-11D0-91FE-00C04FD701A5}'; + IID_IAgentCtlEx: TGUID = '{8563FF20-8ECC-11D1-B9B4-00C04FD97575}'; + DIID__AgentEvents: TGUID = '{F5BE8BD4-7DE6-11D0-91FE-00C04FD701A5}'; + CLASS_Agent: TGUID = '{D45FD31B-5C6E-11D1-9EC1-00C04FD7081F}'; +type + +// *********************************************************************// +// Déclaration Forward des types définis dans la bibliothèque de types +// *********************************************************************// + IAgentCtlCharacters = interface; + IAgentCtlCharactersDisp = dispinterface; + IAgentCtlCharacter = interface; + IAgentCtlCharacterDisp = dispinterface; + IAgentCtlCharacterEx = interface; + IAgentCtlCharacterExDisp = dispinterface; + IAgentCtlBalloon = interface; + IAgentCtlBalloonDisp = dispinterface; + IAgentCtlBalloonEx = interface; + IAgentCtlBalloonExDisp = dispinterface; + IAgentCtlCommands = interface; + IAgentCtlCommandsDisp = dispinterface; + IAgentCtlCommandsEx = interface; + IAgentCtlCommandsExDisp = dispinterface; + IAgentCtlCommand = interface; + IAgentCtlCommandDisp = dispinterface; + IAgentCtlCommandEx = interface; + IAgentCtlCommandExDisp = dispinterface; + IAgentCtlRequest = interface; + IAgentCtlRequestDisp = dispinterface; + IAgentCtlAnimationNames = interface; + IAgentCtlAnimationNamesDisp = dispinterface; + IAgentCtlAudioObject = interface; + IAgentCtlAudioObjectDisp = dispinterface; + IAgentCtlAudioObjectEx = interface; + IAgentCtlAudioObjectExDisp = dispinterface; + IAgentCtlSpeechInput = interface; + IAgentCtlSpeechInputDisp = dispinterface; + IAgentCtlPropertySheet = interface; + IAgentCtlPropertySheetDisp = dispinterface; + IAgentCtlUserInput = interface; + IAgentCtlUserInputDisp = dispinterface; + IAgentCtlCommandsWindow = interface; + IAgentCtlCommandsWindowDisp = dispinterface; + IAgentCtl = interface; + IAgentCtlDisp = dispinterface; + IAgentCtlEx = interface; + IAgentCtlExDisp = dispinterface; + _AgentEvents = dispinterface; + +// *********************************************************************// +// Déclaration de CoClasses définies dans la bibliothèque de types +// (REMARQUE: On affecte chaque CoClass à son Interface par défaut) +// *********************************************************************// + Agent = IAgentCtlEx; + + +// *********************************************************************// +// Interface : IAgentCtlCharacters +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BE8-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCharacters = interface(IDispatch) + ['{F5BE8BE8-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Item(const CharacterID: WideString): IAgentCtlCharacterEx; safecall; + function Character(const CharacterID: WideString): IAgentCtlCharacterEx; safecall; + function Get_Enum: IUnknown; safecall; + procedure Unload(const CharacterID: WideString); safecall; + function Load(const CharacterID: WideString; LoadKey: OleVariant): IAgentCtlRequest; safecall; + property Item[const CharacterID: WideString]: IAgentCtlCharacterEx read Get_Item; default; + property Enum: IUnknown read Get_Enum; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCharactersDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BE8-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCharactersDisp = dispinterface + ['{F5BE8BE8-7DE6-11D0-91FE-00C04FD701A5}'] + property Item[const CharacterID: WideString]: IAgentCtlCharacterEx readonly dispid 0; default; + function Character(const CharacterID: WideString): IAgentCtlCharacterEx; dispid 3; + property Enum: IUnknown readonly dispid -4; + procedure Unload(const CharacterID: WideString); dispid 2; + function Load(const CharacterID: WideString; LoadKey: OleVariant): IAgentCtlRequest; dispid 1; + end; + +// *********************************************************************// +// Interface : IAgentCtlCharacter +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BD9-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCharacter = interface(IDispatch) + ['{F5BE8BD9-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Balloon: IAgentCtlBalloonEx; safecall; + function Get_Commands: IAgentCtlCommandsEx; safecall; + function Get_Name: WideString; safecall; + function Get_Description: WideString; safecall; + function Get_Visible: WordBool; safecall; + procedure Set_Left(Left: Smallint); safecall; + function Get_Left: Smallint; safecall; + procedure Set_Top(Top: Smallint); safecall; + function Get_Top: Smallint; safecall; + procedure Set_Height(Height: Smallint); safecall; + function Get_Height: Smallint; safecall; + procedure Set_Width(Width: Smallint); safecall; + function Get_Width: Smallint; safecall; + function Get_Speed: Integer; safecall; + function Get_Pitch: Integer; safecall; + procedure Set_IdleOn(On_: WordBool); safecall; + function Get_IdleOn: WordBool; safecall; + function Activate(State: OleVariant): WordBool; safecall; + function Play(const Animation: WideString): IAgentCtlRequest; safecall; + function Get(const Type_: WideString; const Name: WideString; Queue: OleVariant): IAgentCtlRequest; safecall; + procedure Stop(Request: OleVariant); safecall; + function Wait(const WaitForRequest: IDispatch): IAgentCtlRequest; safecall; + function Interrupt(const InterruptRequest: IDispatch): IAgentCtlRequest; safecall; + function Speak(Text: OleVariant; Url: OleVariant): IAgentCtlRequest; safecall; + function GestureAt(x: Smallint; y: Smallint): IAgentCtlRequest; safecall; + function MoveTo(x: Smallint; y: Smallint; Speed: OleVariant): IAgentCtlRequest; safecall; + function Hide(Fast: OleVariant): IAgentCtlRequest; safecall; + function Show(Fast: OleVariant): IAgentCtlRequest; safecall; + procedure StopAll(Types: OleVariant); safecall; + function Get_MoveCause: Smallint; safecall; + function Get_VisibilityCause: Smallint; safecall; + function Get_HasOtherClients: WordBool; safecall; + procedure Set_SoundEffectsOn(On_: WordBool); safecall; + function Get_SoundEffectsOn: WordBool; safecall; + procedure Set_Name(const Name: WideString); safecall; + procedure Set_Description(const Description: WideString); safecall; + function Get_ExtraData: WideString; safecall; + property Balloon: IAgentCtlBalloonEx read Get_Balloon; + property Commands: IAgentCtlCommandsEx read Get_Commands; + property Name: WideString read Get_Name write Set_Name; + property Description: WideString read Get_Description write Set_Description; + property Visible: WordBool read Get_Visible; + property Left: Smallint read Get_Left write Set_Left; + property Top: Smallint read Get_Top write Set_Top; + property Height: Smallint read Get_Height write Set_Height; + property Width: Smallint read Get_Width write Set_Width; + property Speed: Integer read Get_Speed; + property Pitch: Integer read Get_Pitch; + property IdleOn: WordBool read Get_IdleOn write Set_IdleOn; + property MoveCause: Smallint read Get_MoveCause; + property VisibilityCause: Smallint read Get_VisibilityCause; + property HasOtherClients: WordBool read Get_HasOtherClients; + property SoundEffectsOn: WordBool read Get_SoundEffectsOn write Set_SoundEffectsOn; + property ExtraData: WideString read Get_ExtraData; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCharacterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BD9-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCharacterDisp = dispinterface + ['{F5BE8BD9-7DE6-11D0-91FE-00C04FD701A5}'] + property Balloon: IAgentCtlBalloonEx readonly dispid 23; + property Commands: IAgentCtlCommandsEx readonly dispid 25; + property Name: WideString dispid 24; + property Description: WideString dispid 28; + property Visible: WordBool readonly dispid 2; + property Left: Smallint dispid 3; + property Top: Smallint dispid 4; + property Height: Smallint dispid 5; + property Width: Smallint dispid 6; + property Speed: Integer readonly dispid 10; + property Pitch: Integer readonly dispid 11; + property IdleOn: WordBool dispid 29; + function Activate(State: OleVariant): WordBool; dispid 26; + function Play(const Animation: WideString): IAgentCtlRequest; dispid 13; + function Get(const Type_: WideString; const Name: WideString; Queue: OleVariant): IAgentCtlRequest; dispid 27; + procedure Stop(Request: OleVariant); dispid 14; + function Wait(const WaitForRequest: IDispatch): IAgentCtlRequest; dispid 22; + function Interrupt(const InterruptRequest: IDispatch): IAgentCtlRequest; dispid 21; + function Speak(Text: OleVariant; Url: OleVariant): IAgentCtlRequest; dispid 15; + function GestureAt(x: Smallint; y: Smallint): IAgentCtlRequest; dispid 17; + function MoveTo(x: Smallint; y: Smallint; Speed: OleVariant): IAgentCtlRequest; dispid 18; + function Hide(Fast: OleVariant): IAgentCtlRequest; dispid 19; + function Show(Fast: OleVariant): IAgentCtlRequest; dispid 20; + procedure StopAll(Types: OleVariant); dispid 31; + property MoveCause: Smallint readonly dispid 32; + property VisibilityCause: Smallint readonly dispid 33; + property HasOtherClients: WordBool readonly dispid 34; + property SoundEffectsOn: WordBool dispid 35; + property ExtraData: WideString readonly dispid 36; + end; + +// *********************************************************************// +// Interface : IAgentCtlCharacterEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {DE8EF600-2F82-11D1-ACAC-00C04FD97575} +// *********************************************************************// + IAgentCtlCharacterEx = interface(IAgentCtlCharacter) + ['{DE8EF600-2F82-11D1-ACAC-00C04FD97575}'] + function ShowPopupMenu(x: Smallint; y: Smallint): WordBool; safecall; + procedure Set_AutoPopupMenu(On_: WordBool); safecall; + function Get_AutoPopupMenu: WordBool; safecall; + procedure Set_HelpModeOn(On_: WordBool); safecall; + function Get_HelpModeOn: WordBool; safecall; + procedure Set_HelpContextID(ID: Integer); safecall; + function Get_HelpContextID: Integer; safecall; + function Get_Active: Smallint; safecall; + function Listen(Listen: WordBool): WordBool; safecall; + procedure Set_LanguageID(LanguageID: Integer); safecall; + function Get_LanguageID: Integer; safecall; + function Get_SRModeID: WideString; safecall; + procedure Set_SRModeID(const EngineModeId: WideString); safecall; + function Get_TTSModeID: WideString; safecall; + procedure Set_TTSModeID(const EngineModeId: WideString); safecall; + function Get_HelpFile: WideString; safecall; + procedure Set_HelpFile(const File_: WideString); safecall; + function Get_GUID: WideString; safecall; + function Get_OriginalHeight: Smallint; safecall; + function Get_OriginalWidth: Smallint; safecall; + function Think(const Text: WideString): IAgentCtlRequest; safecall; + function Get_Version: WideString; safecall; + function Get_AnimationNames: IAgentCtlAnimationNames; safecall; + function Get_SRStatus: Integer; safecall; + property AutoPopupMenu: WordBool read Get_AutoPopupMenu write Set_AutoPopupMenu; + property HelpModeOn: WordBool read Get_HelpModeOn write Set_HelpModeOn; + property HelpContextID: Integer read Get_HelpContextID write Set_HelpContextID; + property Active: Smallint read Get_Active; + property LanguageID: Integer read Get_LanguageID write Set_LanguageID; + property SRModeID: WideString read Get_SRModeID write Set_SRModeID; + property TTSModeID: WideString read Get_TTSModeID write Set_TTSModeID; + property HelpFile: WideString read Get_HelpFile write Set_HelpFile; + property GUID: WideString read Get_GUID; + property OriginalHeight: Smallint read Get_OriginalHeight; + property OriginalWidth: Smallint read Get_OriginalWidth; + property Version: WideString read Get_Version; + property AnimationNames: IAgentCtlAnimationNames read Get_AnimationNames; + property SRStatus: Integer read Get_SRStatus; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCharacterExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DE8EF600-2F82-11D1-ACAC-00C04FD97575} +// *********************************************************************// + IAgentCtlCharacterExDisp = dispinterface + ['{DE8EF600-2F82-11D1-ACAC-00C04FD97575}'] + function ShowPopupMenu(x: Smallint; y: Smallint): WordBool; dispid 37; + property AutoPopupMenu: WordBool dispid 38; + property HelpModeOn: WordBool dispid 39; + property HelpContextID: Integer dispid 40; + property Active: Smallint readonly dispid 41; + function Listen(Listen: WordBool): WordBool; dispid 42; + property LanguageID: Integer dispid 43; + property SRModeID: WideString dispid 46; + property TTSModeID: WideString dispid 47; + property HelpFile: WideString dispid 48; + property GUID: WideString readonly dispid 49; + property OriginalHeight: Smallint readonly dispid 50; + property OriginalWidth: Smallint readonly dispid 51; + function Think(const Text: WideString): IAgentCtlRequest; dispid 52; + property Version: WideString readonly dispid 53; + property AnimationNames: IAgentCtlAnimationNames readonly dispid 54; + property SRStatus: Integer readonly dispid 55; + property Balloon: IAgentCtlBalloonEx readonly dispid 23; + property Commands: IAgentCtlCommandsEx readonly dispid 25; + property Name: WideString dispid 24; + property Description: WideString dispid 28; + property Visible: WordBool readonly dispid 2; + property Left: Smallint dispid 3; + property Top: Smallint dispid 4; + property Height: Smallint dispid 5; + property Width: Smallint dispid 6; + property Speed: Integer readonly dispid 10; + property Pitch: Integer readonly dispid 11; + property IdleOn: WordBool dispid 29; + function Activate(State: OleVariant): WordBool; dispid 26; + function Play(const Animation: WideString): IAgentCtlRequest; dispid 13; + function Get(const Type_: WideString; const Name: WideString; Queue: OleVariant): IAgentCtlRequest; dispid 27; + procedure Stop(Request: OleVariant); dispid 14; + function Wait(const WaitForRequest: IDispatch): IAgentCtlRequest; dispid 22; + function Interrupt(const InterruptRequest: IDispatch): IAgentCtlRequest; dispid 21; + function Speak(Text: OleVariant; Url: OleVariant): IAgentCtlRequest; dispid 15; + function GestureAt(x: Smallint; y: Smallint): IAgentCtlRequest; dispid 17; + function MoveTo(x: Smallint; y: Smallint; Speed: OleVariant): IAgentCtlRequest; dispid 18; + function Hide(Fast: OleVariant): IAgentCtlRequest; dispid 19; + function Show(Fast: OleVariant): IAgentCtlRequest; dispid 20; + procedure StopAll(Types: OleVariant); dispid 31; + property MoveCause: Smallint readonly dispid 32; + property VisibilityCause: Smallint readonly dispid 33; + property HasOtherClients: WordBool readonly dispid 34; + property SoundEffectsOn: WordBool dispid 35; + property ExtraData: WideString readonly dispid 36; + end; + +// *********************************************************************// +// Interface : IAgentCtlBalloon +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BD3-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlBalloon = interface(IDispatch) + ['{F5BE8BD3-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Enabled: WordBool; safecall; + function Get_NumberOfLines: Integer; safecall; + function Get_CharsPerLine: Integer; safecall; + function Get_FontName: WideString; safecall; + function Get_FontSize: Integer; safecall; + function Get_FontBold: WordBool; safecall; + function Get_FontItalic: WordBool; safecall; + function Get_FontStrikethru: WordBool; safecall; + function Get_FontUnderline: WordBool; safecall; + function Get_ForeColor: Integer; safecall; + function Get_BackColor: Integer; safecall; + function Get_BorderColor: Integer; safecall; + procedure Set_Visible(Visible: WordBool); safecall; + function Get_Visible: WordBool; safecall; + procedure Set_FontName(const FontName: WideString); safecall; + procedure Set_FontSize(FontSize: Integer); safecall; + procedure Set_FontCharSet(FontCharSet: Smallint); safecall; + function Get_FontCharSet: Smallint; safecall; + property Enabled: WordBool read Get_Enabled; + property NumberOfLines: Integer read Get_NumberOfLines; + property CharsPerLine: Integer read Get_CharsPerLine; + property FontName: WideString read Get_FontName write Set_FontName; + property FontSize: Integer read Get_FontSize write Set_FontSize; + property FontBold: WordBool read Get_FontBold; + property FontItalic: WordBool read Get_FontItalic; + property FontStrikethru: WordBool read Get_FontStrikethru; + property FontUnderline: WordBool read Get_FontUnderline; + property ForeColor: Integer read Get_ForeColor; + property BackColor: Integer read Get_BackColor; + property BorderColor: Integer read Get_BorderColor; + property Visible: WordBool read Get_Visible write Set_Visible; + property FontCharSet: Smallint read Get_FontCharSet write Set_FontCharSet; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlBalloonDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BD3-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlBalloonDisp = dispinterface + ['{F5BE8BD3-7DE6-11D0-91FE-00C04FD701A5}'] + property Enabled: WordBool readonly dispid 1; + property NumberOfLines: Integer readonly dispid 2; + property CharsPerLine: Integer readonly dispid 3; + property FontName: WideString dispid 4; + property FontSize: Integer dispid 5; + property FontBold: WordBool readonly dispid 10; + property FontItalic: WordBool readonly dispid 11; + property FontStrikethru: WordBool readonly dispid 12; + property FontUnderline: WordBool readonly dispid 13; + property ForeColor: Integer readonly dispid 7; + property BackColor: Integer readonly dispid 8; + property BorderColor: Integer readonly dispid 9; + property Visible: WordBool dispid 14; + property FontCharSet: Smallint dispid 15; + end; + +// *********************************************************************// +// Interface : IAgentCtlBalloonEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {822DB1C0-8879-11D1-9EC6-00C04FD7081F} +// *********************************************************************// + IAgentCtlBalloonEx = interface(IAgentCtlBalloon) + ['{822DB1C0-8879-11D1-9EC6-00C04FD7081F}'] + procedure Set_Style(Style: Integer); safecall; + function Get_Style: Integer; safecall; + property Style: Integer read Get_Style write Set_Style; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlBalloonExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {822DB1C0-8879-11D1-9EC6-00C04FD7081F} +// *********************************************************************// + IAgentCtlBalloonExDisp = dispinterface + ['{822DB1C0-8879-11D1-9EC6-00C04FD7081F}'] + property Style: Integer dispid 16; + property Enabled: WordBool readonly dispid 1; + property NumberOfLines: Integer readonly dispid 2; + property CharsPerLine: Integer readonly dispid 3; + property FontName: WideString dispid 4; + property FontSize: Integer dispid 5; + property FontBold: WordBool readonly dispid 10; + property FontItalic: WordBool readonly dispid 11; + property FontStrikethru: WordBool readonly dispid 12; + property FontUnderline: WordBool readonly dispid 13; + property ForeColor: Integer readonly dispid 7; + property BackColor: Integer readonly dispid 8; + property BorderColor: Integer readonly dispid 9; + property Visible: WordBool dispid 14; + property FontCharSet: Smallint dispid 15; + end; + +// *********************************************************************// +// Interface : IAgentCtlCommands +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BE1-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCommands = interface(IDispatch) + ['{F5BE8BE1-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Item(const Name: WideString): IAgentCtlCommandEx; safecall; + function Command(const Name: WideString): IAgentCtlCommandEx; safecall; + function Get_Count: Integer; safecall; + function Get_Caption: WideString; safecall; + procedure Set_Caption(const Caption: WideString); safecall; + function Get_Voice: WideString; safecall; + procedure Set_Voice(const Voice: WideString); safecall; + function Get_Visible: WordBool; safecall; + procedure Set_Visible(Visible: WordBool); safecall; + function Get_Enum: IUnknown; safecall; + function Add(const Name: WideString; Caption: OleVariant; Voice: OleVariant; + Enabled: OleVariant; Visible: OleVariant): IAgentCtlCommand; safecall; + function Insert(const Name: WideString; const RefName: WideString; Before: OleVariant; + Caption: OleVariant; Voice: OleVariant; Enabled: OleVariant; + Visible: OleVariant): IAgentCtlCommand; safecall; + procedure Remove(const Name: WideString); safecall; + procedure RemoveAll; safecall; + property Item[const Name: WideString]: IAgentCtlCommandEx read Get_Item; default; + property Count: Integer read Get_Count; + property Caption: WideString read Get_Caption write Set_Caption; + property Voice: WideString read Get_Voice write Set_Voice; + property Visible: WordBool read Get_Visible write Set_Visible; + property Enum: IUnknown read Get_Enum; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCommandsDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BE1-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCommandsDisp = dispinterface + ['{F5BE8BE1-7DE6-11D0-91FE-00C04FD701A5}'] + property Item[const Name: WideString]: IAgentCtlCommandEx readonly dispid 0; default; + function Command(const Name: WideString): IAgentCtlCommandEx; dispid 15; + property Count: Integer readonly dispid 2; + property Caption: WideString dispid 3; + property Voice: WideString dispid 4; + property Visible: WordBool dispid 5; + property Enum: IUnknown readonly dispid -4; + function Add(const Name: WideString; Caption: OleVariant; Voice: OleVariant; + Enabled: OleVariant; Visible: OleVariant): IAgentCtlCommand; dispid 10; + function Insert(const Name: WideString; const RefName: WideString; Before: OleVariant; + Caption: OleVariant; Voice: OleVariant; Enabled: OleVariant; + Visible: OleVariant): IAgentCtlCommand; dispid 11; + procedure Remove(const Name: WideString); dispid 13; + procedure RemoveAll; dispid 14; + end; + +// *********************************************************************// +// Interface : IAgentCtlCommandsEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {6BA90C01-3910-11D1-ACB3-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandsEx = interface(IAgentCtlCommands) + ['{6BA90C01-3910-11D1-ACB3-00C04FD97575}'] + procedure Set_DefaultCommand(const Name: WideString); safecall; + function Get_DefaultCommand: WideString; safecall; + procedure Set_HelpContextID(ID: Integer); safecall; + function Get_HelpContextID: Integer; safecall; + procedure Set_FontName(const FontName: WideString); safecall; + function Get_FontName: WideString; safecall; + function Get_FontSize: Integer; safecall; + procedure Set_FontSize(FontSize: Integer); safecall; + procedure Set_VoiceCaption(const VoiceCaption: WideString); safecall; + function Get_VoiceCaption: WideString; safecall; + procedure Set_GlobalVoiceCommandsEnabled(Enable: WordBool); safecall; + function Get_GlobalVoiceCommandsEnabled: WordBool; safecall; + property DefaultCommand: WideString read Get_DefaultCommand write Set_DefaultCommand; + property HelpContextID: Integer read Get_HelpContextID write Set_HelpContextID; + property FontName: WideString read Get_FontName write Set_FontName; + property FontSize: Integer read Get_FontSize write Set_FontSize; + property VoiceCaption: WideString read Get_VoiceCaption write Set_VoiceCaption; + property GlobalVoiceCommandsEnabled: WordBool read Get_GlobalVoiceCommandsEnabled write Set_GlobalVoiceCommandsEnabled; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCommandsExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6BA90C01-3910-11D1-ACB3-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandsExDisp = dispinterface + ['{6BA90C01-3910-11D1-ACB3-00C04FD97575}'] + property DefaultCommand: WideString dispid 16; + property HelpContextID: Integer dispid 17; + property FontName: WideString dispid 21; + property FontSize: Integer dispid 23; + property VoiceCaption: WideString dispid 22; + property GlobalVoiceCommandsEnabled: WordBool dispid 24; + property Item[const Name: WideString]: IAgentCtlCommandEx readonly dispid 0; default; + function Command(const Name: WideString): IAgentCtlCommandEx; dispid 15; + property Count: Integer readonly dispid 2; + property Caption: WideString dispid 3; + property Voice: WideString dispid 4; + property Visible: WordBool dispid 5; + property Enum: IUnknown readonly dispid -4; + function Add(const Name: WideString; Caption: OleVariant; Voice: OleVariant; + Enabled: OleVariant; Visible: OleVariant): IAgentCtlCommand; dispid 10; + function Insert(const Name: WideString; const RefName: WideString; Before: OleVariant; + Caption: OleVariant; Voice: OleVariant; Enabled: OleVariant; + Visible: OleVariant): IAgentCtlCommand; dispid 11; + procedure Remove(const Name: WideString); dispid 13; + procedure RemoveAll; dispid 14; + end; + +// *********************************************************************// +// Interface : IAgentCtlCommand +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BE3-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCommand = interface(IDispatch) + ['{F5BE8BE3-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Voice: WideString; safecall; + procedure Set_Voice(const Voice: WideString); safecall; + function Get_Caption: WideString; safecall; + procedure Set_Caption(const Caption: WideString); safecall; + function Get_Enabled: WordBool; safecall; + procedure Set_Enabled(Enabled: WordBool); safecall; + function Get_Visible: WordBool; safecall; + procedure Set_Visible(Visible: WordBool); safecall; + function Get_Confidence: Integer; safecall; + procedure Set_Confidence(Confidence: Integer); safecall; + function Get_ConfidenceText: WideString; safecall; + procedure Set_ConfidenceText(const Text: WideString); safecall; + property Voice: WideString read Get_Voice write Set_Voice; + property Caption: WideString read Get_Caption write Set_Caption; + property Enabled: WordBool read Get_Enabled write Set_Enabled; + property Visible: WordBool read Get_Visible write Set_Visible; + property Confidence: Integer read Get_Confidence write Set_Confidence; + property ConfidenceText: WideString read Get_ConfidenceText write Set_ConfidenceText; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCommandDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BE3-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlCommandDisp = dispinterface + ['{F5BE8BE3-7DE6-11D0-91FE-00C04FD701A5}'] + property Voice: WideString dispid 1; + property Caption: WideString dispid 2; + property Enabled: WordBool dispid 5; + property Visible: WordBool dispid 6; + property Confidence: Integer dispid 3; + property ConfidenceText: WideString dispid 4; + end; + +// *********************************************************************// +// Interface : IAgentCtlCommandEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {B0913410-3B44-11D1-ACBA-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandEx = interface(IAgentCtlCommand) + ['{B0913410-3B44-11D1-ACBA-00C04FD97575}'] + procedure Set_HelpContextID(ID: Integer); safecall; + function Get_HelpContextID: Integer; safecall; + procedure Set_VoiceCaption(const VoiceCaption: WideString); safecall; + function Get_VoiceCaption: WideString; safecall; + property HelpContextID: Integer read Get_HelpContextID write Set_HelpContextID; + property VoiceCaption: WideString read Get_VoiceCaption write Set_VoiceCaption; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCommandExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {B0913410-3B44-11D1-ACBA-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandExDisp = dispinterface + ['{B0913410-3B44-11D1-ACBA-00C04FD97575}'] + property HelpContextID: Integer dispid 7; + property VoiceCaption: WideString dispid 8; + property Voice: WideString dispid 1; + property Caption: WideString dispid 2; + property Enabled: WordBool dispid 5; + property Visible: WordBool dispid 6; + property Confidence: Integer dispid 3; + property ConfidenceText: WideString dispid 4; + end; + +// *********************************************************************// +// Interface : IAgentCtlRequest +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {1DAB85C3-803A-11D0-AC63-00C04FD97575} +// *********************************************************************// + IAgentCtlRequest = interface(IDispatch) + ['{1DAB85C3-803A-11D0-AC63-00C04FD97575}'] + function Get_ID: Integer; safecall; + function Get_Status: Integer; safecall; + function Get_Description: WideString; safecall; + function Get_Number: Integer; safecall; + property ID: Integer read Get_ID; + property Status: Integer read Get_Status; + property Description: WideString read Get_Description; + property Number: Integer read Get_Number; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlRequestDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1DAB85C3-803A-11D0-AC63-00C04FD97575} +// *********************************************************************// + IAgentCtlRequestDisp = dispinterface + ['{1DAB85C3-803A-11D0-AC63-00C04FD97575}'] + property ID: Integer readonly dispid 0; + property Status: Integer readonly dispid 1; + property Description: WideString readonly dispid 2; + property Number: Integer readonly dispid 3; + end; + +// *********************************************************************// +// Interface : IAgentCtlAnimationNames +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {8B77181C-D3EF-11D1-8500-00C04FA34A14} +// *********************************************************************// + IAgentCtlAnimationNames = interface(IDispatch) + ['{8B77181C-D3EF-11D1-8500-00C04FA34A14}'] + function Get_Enum: IUnknown; safecall; + property Enum: IUnknown read Get_Enum; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlAnimationNamesDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8B77181C-D3EF-11D1-8500-00C04FA34A14} +// *********************************************************************// + IAgentCtlAnimationNamesDisp = dispinterface + ['{8B77181C-D3EF-11D1-8500-00C04FA34A14}'] + property Enum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface : IAgentCtlAudioObject +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BDB-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlAudioObject = interface(IDispatch) + ['{F5BE8BDB-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Enabled: WordBool; safecall; + function Get_SoundEffects: WordBool; safecall; + property Enabled: WordBool read Get_Enabled; + property SoundEffects: WordBool read Get_SoundEffects; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlAudioObjectDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BDB-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlAudioObjectDisp = dispinterface + ['{F5BE8BDB-7DE6-11D0-91FE-00C04FD701A5}'] + property Enabled: WordBool readonly dispid 1; + property SoundEffects: WordBool readonly dispid 2; + end; + +// *********************************************************************// +// Interface : IAgentCtlAudioObjectEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BF0-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlAudioObjectEx = interface(IAgentCtlAudioObject) + ['{F5BE8BF0-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Status: Smallint; safecall; + property Status: Smallint read Get_Status; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlAudioObjectExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BF0-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlAudioObjectExDisp = dispinterface + ['{F5BE8BF0-7DE6-11D0-91FE-00C04FD701A5}'] + property Status: Smallint readonly dispid 3; + property Enabled: WordBool readonly dispid 1; + property SoundEffects: WordBool readonly dispid 2; + end; + +// *********************************************************************// +// Interface : IAgentCtlSpeechInput +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BDD-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlSpeechInput = interface(IDispatch) + ['{F5BE8BDD-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Enabled: WordBool; safecall; + function Get_Language: WideString; safecall; + function Get_HotKey: WideString; safecall; + function Get_Installed: WordBool; safecall; + function Get_Engine: WideString; safecall; + procedure Set_Engine(const Engine: WideString); safecall; + function Get_ListeningTip: WordBool; safecall; + property Enabled: WordBool read Get_Enabled; + property Language: WideString read Get_Language; + property HotKey: WideString read Get_HotKey; + property Installed: WordBool read Get_Installed; + property Engine: WideString read Get_Engine write Set_Engine; + property ListeningTip: WordBool read Get_ListeningTip; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlSpeechInputDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BDD-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlSpeechInputDisp = dispinterface + ['{F5BE8BDD-7DE6-11D0-91FE-00C04FD701A5}'] + property Enabled: WordBool readonly dispid 1; + property Language: WideString readonly dispid 2; + property HotKey: WideString readonly dispid 3; + property Installed: WordBool readonly dispid 4; + property Engine: WideString dispid 5; + property ListeningTip: WordBool readonly dispid 6; + end; + +// *********************************************************************// +// Interface : IAgentCtlPropertySheet +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BDF-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlPropertySheet = interface(IDispatch) + ['{F5BE8BDF-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Left: Smallint; safecall; + function Get_Top: Smallint; safecall; + function Get_Height: Smallint; safecall; + function Get_Width: Smallint; safecall; + procedure Set_Visible(Visible: WordBool); safecall; + function Get_Visible: WordBool; safecall; + procedure Set_Page(const Page: WideString); safecall; + function Get_Page: WideString; safecall; + property Left: Smallint read Get_Left; + property Top: Smallint read Get_Top; + property Height: Smallint read Get_Height; + property Width: Smallint read Get_Width; + property Visible: WordBool read Get_Visible write Set_Visible; + property Page: WideString read Get_Page write Set_Page; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlPropertySheetDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BDF-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlPropertySheetDisp = dispinterface + ['{F5BE8BDF-7DE6-11D0-91FE-00C04FD701A5}'] + property Left: Smallint readonly dispid 1; + property Top: Smallint readonly dispid 2; + property Height: Smallint readonly dispid 3; + property Width: Smallint readonly dispid 4; + property Visible: WordBool dispid 6; + property Page: WideString dispid 5; + end; + +// *********************************************************************// +// Interface : IAgentCtlUserInput +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {C4ABF875-8100-11D0-AC63-00C04FD97575} +// *********************************************************************// + IAgentCtlUserInput = interface(IDispatch) + ['{C4ABF875-8100-11D0-AC63-00C04FD97575}'] + function Get_Count: Smallint; safecall; + function Get_Name: WideString; safecall; + function Get_CharacterID: WideString; safecall; + function Get_Confidence: Integer; safecall; + function Get_Voice: WideString; safecall; + function Get_Alt1Name: WideString; safecall; + function Get_Alt1Confidence: Integer; safecall; + function Get_Alt1Voice: WideString; safecall; + function Get_Alt2Name: WideString; safecall; + function Get_Alt2Confidence: Integer; safecall; + function Get_Alt2Voice: WideString; safecall; + property Count: Smallint read Get_Count; + property Name: WideString read Get_Name; + property CharacterID: WideString read Get_CharacterID; + property Confidence: Integer read Get_Confidence; + property Voice: WideString read Get_Voice; + property Alt1Name: WideString read Get_Alt1Name; + property Alt1Confidence: Integer read Get_Alt1Confidence; + property Alt1Voice: WideString read Get_Alt1Voice; + property Alt2Name: WideString read Get_Alt2Name; + property Alt2Confidence: Integer read Get_Alt2Confidence; + property Alt2Voice: WideString read Get_Alt2Voice; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlUserInputDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C4ABF875-8100-11D0-AC63-00C04FD97575} +// *********************************************************************// + IAgentCtlUserInputDisp = dispinterface + ['{C4ABF875-8100-11D0-AC63-00C04FD97575}'] + property Count: Smallint readonly dispid 1610743808; + property Name: WideString readonly dispid 1610743809; + property CharacterID: WideString readonly dispid 1610743810; + property Confidence: Integer readonly dispid 1610743811; + property Voice: WideString readonly dispid 1610743812; + property Alt1Name: WideString readonly dispid 1610743813; + property Alt1Confidence: Integer readonly dispid 1610743814; + property Alt1Voice: WideString readonly dispid 1610743815; + property Alt2Name: WideString readonly dispid 1610743816; + property Alt2Confidence: Integer readonly dispid 1610743817; + property Alt2Voice: WideString readonly dispid 1610743818; + end; + +// *********************************************************************// +// Interface : IAgentCtlCommandsWindow +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {6D0ECB27-9968-11D0-AC6E-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandsWindow = interface(IDispatch) + ['{6D0ECB27-9968-11D0-AC6E-00C04FD97575}'] + function Get_Visible: WordBool; safecall; + procedure Set_Visible(Visible: WordBool); safecall; + function Get_Left: Smallint; safecall; + function Get_Top: Smallint; safecall; + function Get_Height: Smallint; safecall; + function Get_Width: Smallint; safecall; + property Visible: WordBool read Get_Visible write Set_Visible; + property Left: Smallint read Get_Left; + property Top: Smallint read Get_Top; + property Height: Smallint read Get_Height; + property Width: Smallint read Get_Width; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlCommandsWindowDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6D0ECB27-9968-11D0-AC6E-00C04FD97575} +// *********************************************************************// + IAgentCtlCommandsWindowDisp = dispinterface + ['{6D0ECB27-9968-11D0-AC6E-00C04FD97575}'] + property Visible: WordBool dispid 5; + property Left: Smallint readonly dispid 6; + property Top: Smallint readonly dispid 7; + property Height: Smallint readonly dispid 8; + property Width: Smallint readonly dispid 9; + end; + +// *********************************************************************// +// Interface : IAgentCtl +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {F5BE8BD1-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtl = interface(IDispatch) + ['{F5BE8BD1-7DE6-11D0-91FE-00C04FD701A5}'] + function Get_Characters: IAgentCtlCharacters; safecall; + function Get_AudioOutput: IAgentCtlAudioObjectEx; safecall; + function Get_SpeechInput: IAgentCtlSpeechInput; safecall; + function Get_PropertySheet: IAgentCtlPropertySheet; safecall; + function Get_CommandsWindow: IAgentCtlCommandsWindow; safecall; + function Get_Connected: WordBool; safecall; + procedure Set_Connected(Connected: WordBool); safecall; + function Get_Suspended: WordBool; safecall; + property Characters: IAgentCtlCharacters read Get_Characters; + property AudioOutput: IAgentCtlAudioObjectEx read Get_AudioOutput; + property SpeechInput: IAgentCtlSpeechInput read Get_SpeechInput; + property PropertySheet: IAgentCtlPropertySheet read Get_PropertySheet; + property CommandsWindow: IAgentCtlCommandsWindow read Get_CommandsWindow; + property Connected: WordBool read Get_Connected write Set_Connected; + property Suspended: WordBool read Get_Suspended; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5BE8BD1-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + IAgentCtlDisp = dispinterface + ['{F5BE8BD1-7DE6-11D0-91FE-00C04FD701A5}'] + property Characters: IAgentCtlCharacters readonly dispid 3; + property AudioOutput: IAgentCtlAudioObjectEx readonly dispid 4; + property SpeechInput: IAgentCtlSpeechInput readonly dispid 5; + property PropertySheet: IAgentCtlPropertySheet readonly dispid 8; + property CommandsWindow: IAgentCtlCommandsWindow readonly dispid 12; + property Connected: WordBool dispid 9; + property Suspended: WordBool readonly dispid 14; + end; + +// *********************************************************************// +// Interface : IAgentCtlEx +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {8563FF20-8ECC-11D1-B9B4-00C04FD97575} +// *********************************************************************// + IAgentCtlEx = interface(IAgentCtl) + ['{8563FF20-8ECC-11D1-B9B4-00C04FD97575}'] + procedure ShowDefaultCharacterProperties(x: OleVariant; y: OleVariant); safecall; + function Get_RaiseRequestErrors: WordBool; safecall; + procedure Set_RaiseRequestErrors(RaiseErrors: WordBool); safecall; + property RaiseRequestErrors: WordBool read Get_RaiseRequestErrors write Set_RaiseRequestErrors; + end; + +// *********************************************************************// +// DispIntf: IAgentCtlExDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8563FF20-8ECC-11D1-B9B4-00C04FD97575} +// *********************************************************************// + IAgentCtlExDisp = dispinterface + ['{8563FF20-8ECC-11D1-B9B4-00C04FD97575}'] + procedure ShowDefaultCharacterProperties(x: OleVariant; y: OleVariant); dispid 20; + property RaiseRequestErrors: WordBool dispid 21; + property Characters: IAgentCtlCharacters readonly dispid 3; + property AudioOutput: IAgentCtlAudioObjectEx readonly dispid 4; + property SpeechInput: IAgentCtlSpeechInput readonly dispid 5; + property PropertySheet: IAgentCtlPropertySheet readonly dispid 8; + property CommandsWindow: IAgentCtlCommandsWindow readonly dispid 12; + property Connected: WordBool dispid 9; + property Suspended: WordBool readonly dispid 14; + end; + +// *********************************************************************// +// DispIntf: _AgentEvents +// Flags: (4096) Dispatchable +// GUID: {F5BE8BD4-7DE6-11D0-91FE-00C04FD701A5} +// *********************************************************************// + _AgentEvents = dispinterface + ['{F5BE8BD4-7DE6-11D0-91FE-00C04FD701A5}'] + procedure ActivateInput(const CharacterID: WideString); dispid 1; + procedure DeactivateInput(const CharacterID: WideString); dispid 3; + procedure Click(const CharacterID: WideString; Button: Smallint; Shift: Smallint; x: Smallint; + y: Smallint); dispid 2; + procedure DblClick(const CharacterID: WideString; Button: Smallint; Shift: Smallint; + x: Smallint; y: Smallint); dispid 4; + procedure DragStart(const CharacterID: WideString; Button: Smallint; Shift: Smallint; + x: Smallint; y: Smallint); dispid 5; + procedure DragComplete(const CharacterID: WideString; Button: Smallint; Shift: Smallint; + x: Smallint; y: Smallint); dispid 6; + procedure Show(const CharacterID: WideString; Cause: Smallint); dispid 15; + procedure Hide(const CharacterID: WideString; Cause: Smallint); dispid 7; + procedure RequestStart(const Request: IDispatch); dispid 9; + procedure RequestComplete(const Request: IDispatch); dispid 11; + procedure Restart; dispid 21; + procedure Shutdown; dispid 12; + procedure Bookmark(BookmarkID: Integer); dispid 16; + procedure Command(const UserInput: IDispatch); dispid 17; + procedure IdleStart(const CharacterID: WideString); dispid 19; + procedure IdleComplete(const CharacterID: WideString); dispid 20; + procedure Move(const CharacterID: WideString; x: Smallint; y: Smallint; Cause: Smallint); dispid 22; + procedure Size(const CharacterID: WideString; Width: Smallint; Height: Smallint); dispid 23; + procedure BalloonShow(const CharacterID: WideString); dispid 24; + procedure BalloonHide(const CharacterID: WideString); dispid 25; + procedure HelpComplete(const CharacterID: WideString; const Name: WideString; Cause: Smallint); dispid 26; + procedure ListenStart(const CharacterID: WideString); dispid 27; + procedure ListenComplete(const CharacterID: WideString; Cause: Smallint); dispid 28; + procedure DefaultCharacterChange(const GUID: WideString); dispid 30; + procedure AgentPropertyChange; dispid 31; + procedure ActiveClientChange(const CharacterID: WideString; Active: WordBool); dispid 32; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de contrôle OLE +// Nom du contrôle : TAgent +// Chaîne d'aide : Microsoft Agent Control 2.0 +// Interface par défaut : IAgentCtlEx +// DISP Int. Déf. ? : No +// Interface événements : _AgentEvents +// TypeFlags : (2) CanCreate +// *********************************************************************// + TAgentActivateInput = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentDeactivateInput = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentClick = procedure(Sender: TObject; const CharacterID: WideString; Button: Smallint; + Shift: Smallint; x: Smallint; y: Smallint) of object; + TAgentDblClick = procedure(Sender: TObject; const CharacterID: WideString; Button: Smallint; + Shift: Smallint; x: Smallint; y: Smallint) of object; + TAgentDragStart = procedure(Sender: TObject; const CharacterID: WideString; Button: Smallint; + Shift: Smallint; x: Smallint; y: Smallint) of object; + TAgentDragComplete = procedure(Sender: TObject; const CharacterID: WideString; Button: Smallint; + Shift: Smallint; x: Smallint; y: Smallint) of object; + TAgentShow = procedure(Sender: TObject; const CharacterID: WideString; Cause: Smallint) of object; + TAgentHide = procedure(Sender: TObject; const CharacterID: WideString; Cause: Smallint) of object; + TAgentRequestStart = procedure(Sender: TObject; const Request: IDispatch) of object; + TAgentRequestComplete = procedure(Sender: TObject; const Request: IDispatch) of object; + TAgentBookmark = procedure(Sender: TObject; BookmarkID: Integer) of object; + TAgentCommand = procedure(Sender: TObject; const UserInput: IDispatch) of object; + TAgentIdleStart = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentIdleComplete = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentMove = procedure(Sender: TObject; const CharacterID: WideString; x: Smallint; y: Smallint; + Cause: Smallint) of object; + TAgentSize = procedure(Sender: TObject; const CharacterID: WideString; Width: Smallint; + Height: Smallint) of object; + TAgentBalloonShow = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentBalloonHide = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentHelpComplete = procedure(Sender: TObject; const CharacterID: WideString; + const Name: WideString; Cause: Smallint) of object; + TAgentListenStart = procedure(Sender: TObject; const CharacterID: WideString) of object; + TAgentListenComplete = procedure(Sender: TObject; const CharacterID: WideString; Cause: Smallint) of object; + TAgentDefaultCharacterChange = procedure(Sender: TObject; const GUID: WideString) of object; + TAgentActiveClientChange = procedure(Sender: TObject; const CharacterID: WideString; + Active: WordBool) of object; + + TAgent = class(TOleControl) + private + FOnActivateInput: TAgentActivateInput; + FOnDeactivateInput: TAgentDeactivateInput; + FOnClick: TAgentClick; + FOnDblClick: TAgentDblClick; + FOnDragStart: TAgentDragStart; + FOnDragComplete: TAgentDragComplete; + FOnShow: TAgentShow; + FOnHide: TAgentHide; + FOnRequestStart: TAgentRequestStart; + FOnRequestComplete: TAgentRequestComplete; + FOnRestart: TNotifyEvent; + FOnShutdown: TNotifyEvent; + FOnBookmark: TAgentBookmark; + FOnCommand: TAgentCommand; + FOnIdleStart: TAgentIdleStart; + FOnIdleComplete: TAgentIdleComplete; + FOnMove: TAgentMove; + FOnSize: TAgentSize; + FOnBalloonShow: TAgentBalloonShow; + FOnBalloonHide: TAgentBalloonHide; + FOnHelpComplete: TAgentHelpComplete; + FOnListenStart: TAgentListenStart; + FOnListenComplete: TAgentListenComplete; + FOnDefaultCharacterChange: TAgentDefaultCharacterChange; + FOnAgentPropertyChange: TNotifyEvent; + FOnActiveClientChange: TAgentActiveClientChange; + FIntf: IAgentCtlEx; + function GetControlInterface: IAgentCtlEx; + protected + procedure CreateControl; + procedure InitControlData; override; + function Get_Characters: IAgentCtlCharacters; + function Get_AudioOutput: IAgentCtlAudioObjectEx; + function Get_SpeechInput: IAgentCtlSpeechInput; + function Get_PropertySheet: IAgentCtlPropertySheet; + function Get_CommandsWindow: IAgentCtlCommandsWindow; + public + procedure ShowDefaultCharacterProperties; overload; + procedure ShowDefaultCharacterProperties(x: OleVariant); overload; + procedure ShowDefaultCharacterProperties(x: OleVariant; y: OleVariant); overload; + property ControlInterface: IAgentCtlEx read GetControlInterface; + property DefaultInterface: IAgentCtlEx read GetControlInterface; + property Characters: IAgentCtlCharacters read Get_Characters; + property AudioOutput: IAgentCtlAudioObjectEx read Get_AudioOutput; + property SpeechInput: IAgentCtlSpeechInput read Get_SpeechInput; + property PropertySheet: IAgentCtlPropertySheet read Get_PropertySheet; + property CommandsWindow: IAgentCtlCommandsWindow read Get_CommandsWindow; + property Suspended: WordBool index 14 read GetWordBoolProp; + published + property Connected: WordBool index 9 read GetWordBoolProp write SetWordBoolProp stored False; + property RaiseRequestErrors: WordBool index 21 read GetWordBoolProp write SetWordBoolProp stored False; + property OnActivateInput: TAgentActivateInput read FOnActivateInput write FOnActivateInput; + property OnDeactivateInput: TAgentDeactivateInput read FOnDeactivateInput write FOnDeactivateInput; + property OnClick: TAgentClick read FOnClick write FOnClick; + property OnDblClick: TAgentDblClick read FOnDblClick write FOnDblClick; + property OnDragStart: TAgentDragStart read FOnDragStart write FOnDragStart; + property OnDragComplete: TAgentDragComplete read FOnDragComplete write FOnDragComplete; + property OnShow: TAgentShow read FOnShow write FOnShow; + property OnHide: TAgentHide read FOnHide write FOnHide; + property OnRequestStart: TAgentRequestStart read FOnRequestStart write FOnRequestStart; + property OnRequestComplete: TAgentRequestComplete read FOnRequestComplete write FOnRequestComplete; + property OnRestart: TNotifyEvent read FOnRestart write FOnRestart; + property OnShutdown: TNotifyEvent read FOnShutdown write FOnShutdown; + property OnBookmark: TAgentBookmark read FOnBookmark write FOnBookmark; + property OnCommand: TAgentCommand read FOnCommand write FOnCommand; + property OnIdleStart: TAgentIdleStart read FOnIdleStart write FOnIdleStart; + property OnIdleComplete: TAgentIdleComplete read FOnIdleComplete write FOnIdleComplete; + property OnMove: TAgentMove read FOnMove write FOnMove; + property OnSize: TAgentSize read FOnSize write FOnSize; + property OnBalloonShow: TAgentBalloonShow read FOnBalloonShow write FOnBalloonShow; + property OnBalloonHide: TAgentBalloonHide read FOnBalloonHide write FOnBalloonHide; + property OnHelpComplete: TAgentHelpComplete read FOnHelpComplete write FOnHelpComplete; + property OnListenStart: TAgentListenStart read FOnListenStart write FOnListenStart; + property OnListenComplete: TAgentListenComplete read FOnListenComplete write FOnListenComplete; + property OnDefaultCharacterChange: TAgentDefaultCharacterChange read FOnDefaultCharacterChange write FOnDefaultCharacterChange; + property OnAgentPropertyChange: TNotifyEvent read FOnAgentPropertyChange write FOnAgentPropertyChange; + property OnActiveClientChange: TAgentActiveClientChange read FOnActiveClientChange write FOnActiveClientChange; + end; + +procedure Register; + +implementation + +uses ComObj; + +procedure TAgent.InitControlData; +const + CEventDispIDs: array [0..25] of DWORD = ( + $00000001, $00000003, $00000002, $00000004, $00000005, $00000006, + $0000000F, $00000007, $00000009, $0000000B, $00000015, $0000000C, + $00000010, $00000011, $00000013, $00000014, $00000016, $00000017, + $00000018, $00000019, $0000001A, $0000001B, $0000001C, $0000001E, + $0000001F, $00000020); + CControlData: TControlData2 = ( + ClassID: '{D45FD31B-5C6E-11D1-9EC1-00C04FD7081F}'; + EventIID: '{F5BE8BD4-7DE6-11D0-91FE-00C04FD701A5}'; + EventCount: 26; + EventDispIDs: @CEventDispIDs; + LicenseKey: nil (*HR:$80004002*); + Flags: $00000000; + Version: 401); +begin + ControlData := @CControlData; + TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnActivateInput) - Cardinal(Self); +end; + +procedure TAgent.CreateControl; + + procedure DoCreate; + begin + FIntf := IUnknown(OleObject) as IAgentCtlEx; + end; + +begin + if FIntf = nil then DoCreate; +end; + +function TAgent.GetControlInterface: IAgentCtlEx; +begin + CreateControl; + Result := FIntf; +end; + +function TAgent.Get_Characters: IAgentCtlCharacters; +begin + Result := DefaultInterface.Get_Characters; +end; + +function TAgent.Get_AudioOutput: IAgentCtlAudioObjectEx; +begin + Result := DefaultInterface.Get_AudioOutput; +end; + +function TAgent.Get_SpeechInput: IAgentCtlSpeechInput; +begin + Result := DefaultInterface.Get_SpeechInput; +end; + +function TAgent.Get_PropertySheet: IAgentCtlPropertySheet; +begin + Result := DefaultInterface.Get_PropertySheet; +end; + +function TAgent.Get_CommandsWindow: IAgentCtlCommandsWindow; +begin + Result := DefaultInterface.Get_CommandsWindow; +end; + +procedure TAgent.ShowDefaultCharacterProperties; +begin + DefaultInterface.ShowDefaultCharacterProperties(EmptyParam, EmptyParam); +end; + +procedure TAgent.ShowDefaultCharacterProperties(x: OleVariant); +begin + DefaultInterface.ShowDefaultCharacterProperties(x, EmptyParam); +end; + +procedure TAgent.ShowDefaultCharacterProperties(x: OleVariant; y: OleVariant); +begin + DefaultInterface.ShowDefaultCharacterProperties(x, y); +end; + +procedure Register; +begin + RegisterComponents('ActiveX',[TAgent]); +end; + +end. diff --git a/src/imports/MSXML_TLB.dcr b/src/imports/MSXML_TLB.dcr new file mode 100644 index 0000000..ed60107 Binary files /dev/null and b/src/imports/MSXML_TLB.dcr differ diff --git a/src/imports/MSXML_TLB.pas b/src/imports/MSXML_TLB.pas new file mode 100644 index 0000000..d943a89 --- /dev/null +++ b/src/imports/MSXML_TLB.pas @@ -0,0 +1,3541 @@ +unit MSXML_TLB; + +// ************************************************************************ // +// AVERTISSEMENT +// ------- +// Les types déclarés dans ce fichier ont été générés à partir de données lues +// depuis la bibliothèque de types. Si cette dernière (via une autre bibliothèque de types +// s'y référant) est explicitement ou indirectement ré-importée, ou la commande "Rafraîchir" +// de l'éditeur de bibliothèque de types est activée lors de la modification de la bibliothèque +// de types, le contenu de ce fichier sera régénéré et toutes les modifications +// manuellement apportées seront perdues. +// ************************************************************************ // + +// PASTLWTR : $Revision: 1.88.1.0.1.0 $ +// Fichier généré le 18/07/2001 16:01:13 depuis la bibliothèque de types ci-dessous. + +// *************************************************************************// +// REMARQUE : +// Les éléments gardés par $IFDEF_LIVE_SERVER_AT_DESIGN_TIME sont utilisés par +// des propriétés qui renvoient des objets pouvant nécessiter d'être créés par +// un appel de fonction avant tout accès via la propriété. Ces éléments ont été +// désactivés pour prévenir une utilisation accidentelle depuis l'Inspecteur +// d'objets. Vous pouvez les activer en définissant LIVE_SERVER_AT_DESIGN_TIME +// ou en les retirant sélectivement des blocs $IFDEF. Cependant, ces éléments +// doivent toujours être créés par programmation via une méthode da la CoClass +// appropriée avant d'être utilisés. +// ************************************************************************ // +// Bibl.Types : C:\WINDOWS\System32\msxml.dll (1) +// IID\LCID : {D63E0CE2-A0A2-11D0-9C02-00C04FC99C8E}\0 +// Fichier d'aide : +// DepndLst : +// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb) +// (2) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll) +// Erreurs : +// Remarque : paramètre 'type' dans IXMLDOMNode.nodeType changé en 'type_' +// Conseil : Membre 'implementation' de 'IXMLDOMDocument' modifié en 'implementation_' +// Remarque : paramètre 'type' dans IXMLDOMDocument.createNode changé en 'type_' +// Conseil : Membre 'type' de 'IXMLElement' modifié en 'type_' +// Conseil : Membre 'type' de 'IXMLElement2' modifié en 'type_' +// ************************************************************************ // +{$TYPEDADDRESS OFF} // L'unité doit être compilée sans vérification de type des pointeurs. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// GUIDS déclarés dans la bibliothèque de types. Préfixes utilisés : +// Bibliothèques de types : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces : IID_xxxx +// *********************************************************************// +const + // Version majeure et mineure de la bibliothèque de types + MSXMLMajorVersion = 2; + MSXMLMinorVersion = 0; + + LIBID_MSXML: TGUID = '{D63E0CE2-A0A2-11D0-9C02-00C04FC99C8E}'; + + IID_IXMLDOMImplementation: TGUID = '{2933BF8F-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNode: TGUID = '{2933BF80-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNodeList: TGUID = '{2933BF82-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNamedNodeMap: TGUID = '{2933BF83-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocument: TGUID = '{2933BF81-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocumentType: TGUID = '{2933BF8B-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMElement: TGUID = '{2933BF86-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMAttribute: TGUID = '{2933BF85-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocumentFragment: TGUID = '{3EFAA413-272F-11D2-836F-0000F87A7782}'; + IID_IXMLDOMCharacterData: TGUID = '{2933BF84-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMText: TGUID = '{2933BF87-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMComment: TGUID = '{2933BF88-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMCDATASection: TGUID = '{2933BF8A-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMProcessingInstruction: TGUID = '{2933BF89-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMEntityReference: TGUID = '{2933BF8E-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMParseError: TGUID = '{3EFAA426-272F-11D2-836F-0000F87A7782}'; + IID_IXMLDOMNotation: TGUID = '{2933BF8C-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMEntity: TGUID = '{2933BF8D-7B36-11D2-B20E-00C04F983E60}'; + IID_IXTLRuntime: TGUID = '{3EFAA425-272F-11D2-836F-0000F87A7782}'; + DIID_XMLDOMDocumentEvents: TGUID = '{3EFAA427-272F-11D2-836F-0000F87A7782}'; + CLASS_DOMDocument: TGUID = '{2933BF90-7B36-11D2-B20E-00C04F983E60}'; + CLASS_DOMFreeThreadedDocument: TGUID = '{2933BF91-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLHttpRequest: TGUID = '{ED8C108D-4349-11D2-91A4-00C04F7969E8}'; + CLASS_XMLHTTPRequest: TGUID = '{ED8C108E-4349-11D2-91A4-00C04F7969E8}'; + IID_IXMLDSOControl: TGUID = '{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'; + CLASS_XMLDSOControl: TGUID = '{550DDA30-0541-11D2-9CA9-0060B0EC3D39}'; + IID_IXMLElementCollection: TGUID = '{65725580-9B5D-11D0-9BFE-00C04FC99C8E}'; + IID_IXMLDocument: TGUID = '{F52E2B61-18A1-11D1-B105-00805F49916B}'; + IID_IXMLElement: TGUID = '{3F7F31AC-E15F-11D0-9C25-00C04FC99C8E}'; + IID_IXMLDocument2: TGUID = '{2B8DE2FE-8D2D-11D1-B2FC-00C04FD915A9}'; + IID_IXMLElement2: TGUID = '{2B8DE2FF-8D2D-11D1-B2FC-00C04FD915A9}'; + IID_IXMLAttribute: TGUID = '{D4D4A0FC-3B73-11D1-B2B4-00C04FB92596}'; + IID_IXMLError: TGUID = '{948C5AD3-C58D-11D0-9C0B-00C04FC99C8E}'; + CLASS_XMLDocument: TGUID = '{CFC399AF-D876-11D0-9C10-00C04FC99C8E}'; + +// *********************************************************************// +// Déclaration d'énumérations définies dans la bibliothèque de types +// *********************************************************************// +// Constantes pour enum tagDOMNodeType +type + tagDOMNodeType = TOleEnum; +const + NODE_INVALID = $00000000; + NODE_ELEMENT = $00000001; + NODE_ATTRIBUTE = $00000002; + NODE_TEXT = $00000003; + NODE_CDATA_SECTION = $00000004; + NODE_ENTITY_REFERENCE = $00000005; + NODE_ENTITY = $00000006; + NODE_PROCESSING_INSTRUCTION = $00000007; + NODE_COMMENT = $00000008; + NODE_DOCUMENT = $00000009; + NODE_DOCUMENT_TYPE = $0000000A; + NODE_DOCUMENT_FRAGMENT = $0000000B; + NODE_NOTATION = $0000000C; + +// Constantes pour enum tagXMLEMEM_TYPE +type + tagXMLEMEM_TYPE = TOleEnum; +const + XMLELEMTYPE_ELEMENT = $00000000; + XMLELEMTYPE_TEXT = $00000001; + XMLELEMTYPE_COMMENT = $00000002; + XMLELEMTYPE_DOCUMENT = $00000003; + XMLELEMTYPE_DTD = $00000004; + XMLELEMTYPE_PI = $00000005; + XMLELEMTYPE_OTHER = $00000006; + +type + +// *********************************************************************// +// Déclaration Forward des types définis dans la bibliothèque de types +// *********************************************************************// + IXMLDOMImplementation = interface; + IXMLDOMImplementationDisp = dispinterface; + IXMLDOMNode = interface; + IXMLDOMNodeDisp = dispinterface; + IXMLDOMNodeList = interface; + IXMLDOMNodeListDisp = dispinterface; + IXMLDOMNamedNodeMap = interface; + IXMLDOMNamedNodeMapDisp = dispinterface; + IXMLDOMDocument = interface; + IXMLDOMDocumentDisp = dispinterface; + IXMLDOMDocumentType = interface; + IXMLDOMDocumentTypeDisp = dispinterface; + IXMLDOMElement = interface; + IXMLDOMElementDisp = dispinterface; + IXMLDOMAttribute = interface; + IXMLDOMAttributeDisp = dispinterface; + IXMLDOMDocumentFragment = interface; + IXMLDOMDocumentFragmentDisp = dispinterface; + IXMLDOMCharacterData = interface; + IXMLDOMCharacterDataDisp = dispinterface; + IXMLDOMText = interface; + IXMLDOMTextDisp = dispinterface; + IXMLDOMComment = interface; + IXMLDOMCommentDisp = dispinterface; + IXMLDOMCDATASection = interface; + IXMLDOMCDATASectionDisp = dispinterface; + IXMLDOMProcessingInstruction = interface; + IXMLDOMProcessingInstructionDisp = dispinterface; + IXMLDOMEntityReference = interface; + IXMLDOMEntityReferenceDisp = dispinterface; + IXMLDOMParseError = interface; + IXMLDOMParseErrorDisp = dispinterface; + IXMLDOMNotation = interface; + IXMLDOMNotationDisp = dispinterface; + IXMLDOMEntity = interface; + IXMLDOMEntityDisp = dispinterface; + IXTLRuntime = interface; + IXTLRuntimeDisp = dispinterface; + XMLDOMDocumentEvents = dispinterface; + IXMLHttpRequest = interface; + IXMLHttpRequestDisp = dispinterface; + IXMLDSOControl = interface; + IXMLDSOControlDisp = dispinterface; + IXMLElementCollection = interface; + IXMLElementCollectionDisp = dispinterface; + IXMLDocument = interface; + IXMLDocumentDisp = dispinterface; + IXMLElement = interface; + IXMLElementDisp = dispinterface; + IXMLDocument2 = interface; + IXMLElement2 = interface; + IXMLElement2Disp = dispinterface; + IXMLAttribute = interface; + IXMLAttributeDisp = dispinterface; + IXMLError = interface; + +// *********************************************************************// +// Déclaration de CoClasses définies dans la bibliothèque de types +// (REMARQUE: On affecte chaque CoClass à son Interface par défaut) +// *********************************************************************// + DOMDocument = IXMLDOMDocument; + DOMFreeThreadedDocument = IXMLDOMDocument; + XMLHTTPRequest = IXMLHttpRequest; + XMLDSOControl = IXMLDSOControl; + XMLDocument = IXMLDocument2; + + +// *********************************************************************// +// Déclaration de structures, d'unions et alias. +// *********************************************************************// + PUserType1 = ^_xml_error; {*} + + DOMNodeType = tagDOMNodeType; + + _xml_error = packed record + _nLine: SYSUINT; + _pchBuf: WideString; + _cchBuf: SYSUINT; + _ich: SYSUINT; + _pszFound: WideString; + _pszExpected: WideString; + _reserved1: LongWord; + _reserved2: LongWord; + end; + + XMLELEM_TYPE = tagXMLEMEM_TYPE; + +// *********************************************************************// +// Interface : IXMLDOMImplementation +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8F-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMImplementation = interface(IDispatch) + ['{2933BF8F-7B36-11D2-B20E-00C04F983E60}'] + function hasFeature(const feature: WideString; const version: WideString): WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMImplementationDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8F-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMImplementationDisp = dispinterface + ['{2933BF8F-7B36-11D2-B20E-00C04F983E60}'] + function hasFeature(const feature: WideString; const version: WideString): WordBool; dispid 145; + end; + +// *********************************************************************// +// Interface : IXMLDOMNode +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF80-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNode = interface(IDispatch) + ['{2933BF80-7B36-11D2-B20E-00C04F983E60}'] + function Get_nodeName: WideString; safecall; + function Get_nodeValue: OleVariant; safecall; + procedure Set_nodeValue(value: OleVariant); safecall; + function Get_nodeType: DOMNodeType; safecall; + function Get_parentNode: IXMLDOMNode; safecall; + function Get_childNodes: IXMLDOMNodeList; safecall; + function Get_firstChild: IXMLDOMNode; safecall; + function Get_lastChild: IXMLDOMNode; safecall; + function Get_previousSibling: IXMLDOMNode; safecall; + function Get_nextSibling: IXMLDOMNode; safecall; + function Get_attributes: IXMLDOMNamedNodeMap; safecall; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; safecall; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; safecall; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; safecall; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; safecall; + function hasChildNodes: WordBool; safecall; + function Get_ownerDocument: IXMLDOMDocument; safecall; + function cloneNode(deep: WordBool): IXMLDOMNode; safecall; + function Get_nodeTypeString: WideString; safecall; + function Get_text: WideString; safecall; + procedure Set_text(const text: WideString); safecall; + function Get_specified: WordBool; safecall; + function Get_definition: IXMLDOMNode; safecall; + function Get_nodeTypedValue: OleVariant; safecall; + procedure Set_nodeTypedValue(typedValue: OleVariant); safecall; + function Get_dataType: OleVariant; safecall; + procedure Set_dataType(const dataTypeName: WideString); safecall; + function Get_xml: WideString; safecall; + function transformNode(const stylesheet: IXMLDOMNode): WideString; safecall; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; safecall; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; safecall; + function Get_parsed: WordBool; safecall; + function Get_namespaceURI: WideString; safecall; + function Get_prefix: WideString; safecall; + function Get_baseName: WideString; safecall; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); safecall; + property nodeName: WideString read Get_nodeName; + property nodeValue: OleVariant read Get_nodeValue write Set_nodeValue; + property nodeType: DOMNodeType read Get_nodeType; + property parentNode: IXMLDOMNode read Get_parentNode; + property childNodes: IXMLDOMNodeList read Get_childNodes; + property firstChild: IXMLDOMNode read Get_firstChild; + property lastChild: IXMLDOMNode read Get_lastChild; + property previousSibling: IXMLDOMNode read Get_previousSibling; + property nextSibling: IXMLDOMNode read Get_nextSibling; + property attributes: IXMLDOMNamedNodeMap read Get_attributes; + property ownerDocument: IXMLDOMDocument read Get_ownerDocument; + property nodeTypeString: WideString read Get_nodeTypeString; + property text: WideString read Get_text write Set_text; + property specified: WordBool read Get_specified; + property definition: IXMLDOMNode read Get_definition; + property nodeTypedValue: OleVariant read Get_nodeTypedValue write Set_nodeTypedValue; + property xml: WideString read Get_xml; + property parsed: WordBool read Get_parsed; + property namespaceURI: WideString read Get_namespaceURI; + property prefix: WideString read Get_prefix; + property baseName: WideString read Get_baseName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNodeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF80-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeDisp = dispinterface + ['{2933BF80-7B36-11D2-B20E-00C04F983E60}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMNodeList +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF82-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeList = interface(IDispatch) + ['{2933BF82-7B36-11D2-B20E-00C04F983E60}'] + function Get_item(index: Integer): IXMLDOMNode; safecall; + function Get_length: Integer; safecall; + function nextNode: IXMLDOMNode; safecall; + procedure reset; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: IXMLDOMNode read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNodeListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF82-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeListDisp = dispinterface + ['{2933BF82-7B36-11D2-B20E-00C04F983E60}'] + property item[index: Integer]: IXMLDOMNode readonly dispid 0; default; + property length: Integer readonly dispid 74; + function nextNode: IXMLDOMNode; dispid 76; + procedure reset; dispid 77; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface : IXMLDOMNamedNodeMap +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF83-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNamedNodeMap = interface(IDispatch) + ['{2933BF83-7B36-11D2-B20E-00C04F983E60}'] + function getNamedItem(const name: WideString): IXMLDOMNode; safecall; + function setNamedItem(const newItem: IXMLDOMNode): IXMLDOMNode; safecall; + function removeNamedItem(const name: WideString): IXMLDOMNode; safecall; + function Get_item(index: Integer): IXMLDOMNode; safecall; + function Get_length: Integer; safecall; + function getQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function removeQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function nextNode: IXMLDOMNode; safecall; + procedure reset; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: IXMLDOMNode read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNamedNodeMapDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF83-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNamedNodeMapDisp = dispinterface + ['{2933BF83-7B36-11D2-B20E-00C04F983E60}'] + function getNamedItem(const name: WideString): IXMLDOMNode; dispid 83; + function setNamedItem(const newItem: IXMLDOMNode): IXMLDOMNode; dispid 84; + function removeNamedItem(const name: WideString): IXMLDOMNode; dispid 85; + property item[index: Integer]: IXMLDOMNode readonly dispid 0; default; + property length: Integer readonly dispid 74; + function getQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 87; + function removeQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 88; + function nextNode: IXMLDOMNode; dispid 89; + procedure reset; dispid 90; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface : IXMLDOMDocument +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF81-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument = interface(IXMLDOMNode) + ['{2933BF81-7B36-11D2-B20E-00C04F983E60}'] + function Get_doctype: IXMLDOMDocumentType; safecall; + function Get_implementation_: IXMLDOMImplementation; safecall; + function Get_documentElement: IXMLDOMElement; safecall; + procedure Set_documentElement(const DOMElement: IXMLDOMElement); safecall; + function createElement(const tagName: WideString): IXMLDOMElement; safecall; + function createDocumentFragment: IXMLDOMDocumentFragment; safecall; + function createTextNode(const data: WideString): IXMLDOMText; safecall; + function createComment(const data: WideString): IXMLDOMComment; safecall; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; safecall; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; safecall; + function createAttribute(const name: WideString): IXMLDOMAttribute; safecall; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; safecall; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; safecall; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function nodeFromID(const idString: WideString): IXMLDOMNode; safecall; + function load(xmlSource: OleVariant): WordBool; safecall; + function Get_readyState: Integer; safecall; + function Get_parseError: IXMLDOMParseError; safecall; + function Get_url: WideString; safecall; + function Get_async: WordBool; safecall; + procedure Set_async(isAsync: WordBool); safecall; + procedure abort; safecall; + function loadXML(const bstrXML: WideString): WordBool; safecall; + procedure save(destination: OleVariant); safecall; + function Get_validateOnParse: WordBool; safecall; + procedure Set_validateOnParse(isValidating: WordBool); safecall; + function Get_resolveExternals: WordBool; safecall; + procedure Set_resolveExternals(isResolving: WordBool); safecall; + function Get_preserveWhiteSpace: WordBool; safecall; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); safecall; + procedure Set_onreadystatechange(Param1: OleVariant); safecall; + procedure Set_ondataavailable(Param1: OleVariant); safecall; + procedure Set_ontransformnode(Param1: OleVariant); safecall; + property doctype: IXMLDOMDocumentType read Get_doctype; + property implementation_: IXMLDOMImplementation read Get_implementation_; + property documentElement: IXMLDOMElement read Get_documentElement write Set_documentElement; + property readyState: Integer read Get_readyState; + property parseError: IXMLDOMParseError read Get_parseError; + property url: WideString read Get_url; + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + property onreadystatechange: OleVariant write Set_onreadystatechange; + property ondataavailable: OleVariant write Set_ondataavailable; + property ontransformnode: OleVariant write Set_ontransformnode; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF81-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentDisp = dispinterface + ['{2933BF81-7B36-11D2-B20E-00C04F983E60}'] + property doctype: IXMLDOMDocumentType readonly dispid 38; + property implementation_: IXMLDOMImplementation readonly dispid 39; + property documentElement: IXMLDOMElement dispid 40; + function createElement(const tagName: WideString): IXMLDOMElement; dispid 41; + function createDocumentFragment: IXMLDOMDocumentFragment; dispid 42; + function createTextNode(const data: WideString): IXMLDOMText; dispid 43; + function createComment(const data: WideString): IXMLDOMComment; dispid 44; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; dispid 45; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; dispid 46; + function createAttribute(const name: WideString): IXMLDOMAttribute; dispid 47; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; dispid 49; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 50; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 54; + function nodeFromID(const idString: WideString): IXMLDOMNode; dispid 56; + function load(xmlSource: OleVariant): WordBool; dispid 58; + property readyState: Integer readonly dispid -525; + property parseError: IXMLDOMParseError readonly dispid 59; + property url: WideString readonly dispid 60; + property async: WordBool dispid 61; + procedure abort; dispid 62; + function loadXML(const bstrXML: WideString): WordBool; dispid 63; + procedure save(destination: OleVariant); dispid 64; + property validateOnParse: WordBool dispid 65; + property resolveExternals: WordBool dispid 66; + property preserveWhiteSpace: WordBool dispid 67; + property onreadystatechange: OleVariant writeonly dispid 68; + property ondataavailable: OleVariant writeonly dispid 69; + property ontransformnode: OleVariant writeonly dispid 70; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMDocumentType +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8B-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentType = interface(IXMLDOMNode) + ['{2933BF8B-7B36-11D2-B20E-00C04F983E60}'] + function Get_name: WideString; safecall; + function Get_entities: IXMLDOMNamedNodeMap; safecall; + function Get_notations: IXMLDOMNamedNodeMap; safecall; + property name: WideString read Get_name; + property entities: IXMLDOMNamedNodeMap read Get_entities; + property notations: IXMLDOMNamedNodeMap read Get_notations; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentTypeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8B-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentTypeDisp = dispinterface + ['{2933BF8B-7B36-11D2-B20E-00C04F983E60}'] + property name: WideString readonly dispid 131; + property entities: IXMLDOMNamedNodeMap readonly dispid 132; + property notations: IXMLDOMNamedNodeMap readonly dispid 133; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMElement +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF86-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMElement = interface(IXMLDOMNode) + ['{2933BF86-7B36-11D2-B20E-00C04F983E60}'] + function Get_tagName: WideString; safecall; + function getAttribute(const name: WideString): OleVariant; safecall; + procedure setAttribute(const name: WideString; value: OleVariant); safecall; + procedure removeAttribute(const name: WideString); safecall; + function getAttributeNode(const name: WideString): IXMLDOMAttribute; safecall; + function setAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; safecall; + function removeAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; safecall; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; safecall; + procedure normalize; safecall; + property tagName: WideString read Get_tagName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMElementDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF86-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMElementDisp = dispinterface + ['{2933BF86-7B36-11D2-B20E-00C04F983E60}'] + property tagName: WideString readonly dispid 97; + function getAttribute(const name: WideString): OleVariant; dispid 99; + procedure setAttribute(const name: WideString; value: OleVariant); dispid 100; + procedure removeAttribute(const name: WideString); dispid 101; + function getAttributeNode(const name: WideString): IXMLDOMAttribute; dispid 102; + function setAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; dispid 103; + function removeAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; dispid 104; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 105; + procedure normalize; dispid 106; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMAttribute +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF85-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMAttribute = interface(IXMLDOMNode) + ['{2933BF85-7B36-11D2-B20E-00C04F983E60}'] + function Get_name: WideString; safecall; + function Get_value: OleVariant; safecall; + procedure Set_value(attributeValue: OleVariant); safecall; + property name: WideString read Get_name; + property value: OleVariant read Get_value write Set_value; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMAttributeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF85-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMAttributeDisp = dispinterface + ['{2933BF85-7B36-11D2-B20E-00C04F983E60}'] + property name: WideString readonly dispid 118; + property value: OleVariant dispid 120; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMDocumentFragment +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {3EFAA413-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMDocumentFragment = interface(IXMLDOMNode) + ['{3EFAA413-272F-11D2-836F-0000F87A7782}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentFragmentDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA413-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMDocumentFragmentDisp = dispinterface + ['{3EFAA413-272F-11D2-836F-0000F87A7782}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMCharacterData +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF84-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCharacterData = interface(IXMLDOMNode) + ['{2933BF84-7B36-11D2-B20E-00C04F983E60}'] + function Get_data: WideString; safecall; + procedure Set_data(const data: WideString); safecall; + function Get_length: Integer; safecall; + function substringData(offset: Integer; count: Integer): WideString; safecall; + procedure appendData(const data: WideString); safecall; + procedure insertData(offset: Integer; const data: WideString); safecall; + procedure deleteData(offset: Integer; count: Integer); safecall; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); safecall; + property data: WideString read Get_data write Set_data; + property length: Integer read Get_length; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCharacterDataDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF84-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCharacterDataDisp = dispinterface + ['{2933BF84-7B36-11D2-B20E-00C04F983E60}'] + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMText +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF87-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMText = interface(IXMLDOMCharacterData) + ['{2933BF87-7B36-11D2-B20E-00C04F983E60}'] + function splitText(offset: Integer): IXMLDOMText; safecall; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMTextDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF87-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMTextDisp = dispinterface + ['{2933BF87-7B36-11D2-B20E-00C04F983E60}'] + function splitText(offset: Integer): IXMLDOMText; dispid 123; + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMComment +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF88-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMComment = interface(IXMLDOMCharacterData) + ['{2933BF88-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCommentDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF88-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCommentDisp = dispinterface + ['{2933BF88-7B36-11D2-B20E-00C04F983E60}'] + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMCDATASection +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8A-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCDATASection = interface(IXMLDOMText) + ['{2933BF8A-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCDATASectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8A-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCDATASectionDisp = dispinterface + ['{2933BF8A-7B36-11D2-B20E-00C04F983E60}'] + function splitText(offset: Integer): IXMLDOMText; dispid 123; + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMProcessingInstruction +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF89-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMProcessingInstruction = interface(IXMLDOMNode) + ['{2933BF89-7B36-11D2-B20E-00C04F983E60}'] + function Get_target: WideString; safecall; + function Get_data: WideString; safecall; + procedure Set_data(const value: WideString); safecall; + property target: WideString read Get_target; + property data: WideString read Get_data write Set_data; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMProcessingInstructionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF89-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMProcessingInstructionDisp = dispinterface + ['{2933BF89-7B36-11D2-B20E-00C04F983E60}'] + property target: WideString readonly dispid 127; + property data: WideString dispid 128; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMEntityReference +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8E-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityReference = interface(IXMLDOMNode) + ['{2933BF8E-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMEntityReferenceDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8E-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityReferenceDisp = dispinterface + ['{2933BF8E-7B36-11D2-B20E-00C04F983E60}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMParseError +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {3EFAA426-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseError = interface(IDispatch) + ['{3EFAA426-272F-11D2-836F-0000F87A7782}'] + function Get_errorCode: Integer; safecall; + function Get_url: WideString; safecall; + function Get_reason: WideString; safecall; + function Get_srcText: WideString; safecall; + function Get_line: Integer; safecall; + function Get_linepos: Integer; safecall; + function Get_filepos: Integer; safecall; + property errorCode: Integer read Get_errorCode; + property url: WideString read Get_url; + property reason: WideString read Get_reason; + property srcText: WideString read Get_srcText; + property line: Integer read Get_line; + property linepos: Integer read Get_linepos; + property filepos: Integer read Get_filepos; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMParseErrorDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA426-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseErrorDisp = dispinterface + ['{3EFAA426-272F-11D2-836F-0000F87A7782}'] + property errorCode: Integer readonly dispid 0; + property url: WideString readonly dispid 179; + property reason: WideString readonly dispid 180; + property srcText: WideString readonly dispid 181; + property line: Integer readonly dispid 182; + property linepos: Integer readonly dispid 183; + property filepos: Integer readonly dispid 184; + end; + +// *********************************************************************// +// Interface : IXMLDOMNotation +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8C-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNotation = interface(IXMLDOMNode) + ['{2933BF8C-7B36-11D2-B20E-00C04F983E60}'] + function Get_publicId: OleVariant; safecall; + function Get_systemId: OleVariant; safecall; + property publicId: OleVariant read Get_publicId; + property systemId: OleVariant read Get_systemId; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNotationDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8C-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNotationDisp = dispinterface + ['{2933BF8C-7B36-11D2-B20E-00C04F983E60}'] + property publicId: OleVariant readonly dispid 136; + property systemId: OleVariant readonly dispid 137; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXMLDOMEntity +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {2933BF8D-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntity = interface(IXMLDOMNode) + ['{2933BF8D-7B36-11D2-B20E-00C04F983E60}'] + function Get_publicId: OleVariant; safecall; + function Get_systemId: OleVariant; safecall; + function Get_notationName: WideString; safecall; + property publicId: OleVariant read Get_publicId; + property systemId: OleVariant read Get_systemId; + property notationName: WideString read Get_notationName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMEntityDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8D-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityDisp = dispinterface + ['{2933BF8D-7B36-11D2-B20E-00C04F983E60}'] + property publicId: OleVariant readonly dispid 140; + property systemId: OleVariant readonly dispid 141; + property notationName: WideString readonly dispid 142; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface : IXTLRuntime +// Indicateurs : (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID : {3EFAA425-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXTLRuntime = interface(IXMLDOMNode) + ['{3EFAA425-272F-11D2-836F-0000F87A7782}'] + function uniqueID(const pNode: IXMLDOMNode): Integer; safecall; + function depth(const pNode: IXMLDOMNode): Integer; safecall; + function childNumber(const pNode: IXMLDOMNode): Integer; safecall; + function ancestorChildNumber(const bstrNodeName: WideString; const pNode: IXMLDOMNode): Integer; safecall; + function absoluteChildNumber(const pNode: IXMLDOMNode): Integer; safecall; + function formatIndex(lIndex: Integer; const bstrFormat: WideString): WideString; safecall; + function formatNumber(dblNumber: Double; const bstrFormat: WideString): WideString; safecall; + function formatDate(varDate: OleVariant; const bstrFormat: WideString; + varDestLocale: OleVariant): WideString; safecall; + function formatTime(varTime: OleVariant; const bstrFormat: WideString; + varDestLocale: OleVariant): WideString; safecall; + end; + +// *********************************************************************// +// DispIntf: IXTLRuntimeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA425-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXTLRuntimeDisp = dispinterface + ['{3EFAA425-272F-11D2-836F-0000F87A7782}'] + function uniqueID(const pNode: IXMLDOMNode): Integer; dispid 187; + function depth(const pNode: IXMLDOMNode): Integer; dispid 188; + function childNumber(const pNode: IXMLDOMNode): Integer; dispid 189; + function ancestorChildNumber(const bstrNodeName: WideString; const pNode: IXMLDOMNode): Integer; dispid 190; + function absoluteChildNumber(const pNode: IXMLDOMNode): Integer; dispid 191; + function formatIndex(lIndex: Integer; const bstrFormat: WideString): WideString; dispid 192; + function formatNumber(dblNumber: Double; const bstrFormat: WideString): WideString; dispid 193; + function formatDate(varDate: OleVariant; const bstrFormat: WideString; + varDestLocale: OleVariant): WideString; dispid 194; + function formatTime(varTime: OleVariant; const bstrFormat: WideString; + varDestLocale: OleVariant): WideString; dispid 195; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// DispIntf: XMLDOMDocumentEvents +// Flags: (4112) Hidden Dispatchable +// GUID: {3EFAA427-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + XMLDOMDocumentEvents = dispinterface + ['{3EFAA427-272F-11D2-836F-0000F87A7782}'] + procedure ondataavailable; dispid 198; + procedure onreadystatechange; dispid -609; + end; + +// *********************************************************************// +// Interface : IXMLHttpRequest +// Indicateurs : (4416) Dual OleAutomation Dispatchable +// GUID : {ED8C108D-4349-11D2-91A4-00C04F7969E8} +// *********************************************************************// + IXMLHttpRequest = interface(IDispatch) + ['{ED8C108D-4349-11D2-91A4-00C04F7969E8}'] + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); safecall; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); safecall; + function getResponseHeader(const bstrHeader: WideString): WideString; safecall; + function getAllResponseHeaders: WideString; safecall; + procedure send(varBody: OleVariant); safecall; + procedure abort; safecall; + function Get_status: Integer; safecall; + function Get_statusText: WideString; safecall; + function Get_responseXML: IDispatch; safecall; + function Get_responseText: WideString; safecall; + function Get_responseBody: OleVariant; safecall; + function Get_responseStream: OleVariant; safecall; + function Get_readyState: Integer; safecall; + procedure Set_onreadystatechange(const Param1: IDispatch); safecall; + property status: Integer read Get_status; + property statusText: WideString read Get_statusText; + property responseXML: IDispatch read Get_responseXML; + property responseText: WideString read Get_responseText; + property responseBody: OleVariant read Get_responseBody; + property responseStream: OleVariant read Get_responseStream; + property readyState: Integer read Get_readyState; + property onreadystatechange: IDispatch write Set_onreadystatechange; + end; + +// *********************************************************************// +// DispIntf: IXMLHttpRequestDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {ED8C108D-4349-11D2-91A4-00C04F7969E8} +// *********************************************************************// + IXMLHttpRequestDisp = dispinterface + ['{ED8C108D-4349-11D2-91A4-00C04F7969E8}'] + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); dispid 1; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); dispid 2; + function getResponseHeader(const bstrHeader: WideString): WideString; dispid 3; + function getAllResponseHeaders: WideString; dispid 4; + procedure send(varBody: OleVariant); dispid 5; + procedure abort; dispid 6; + property status: Integer readonly dispid 7; + property statusText: WideString readonly dispid 8; + property responseXML: IDispatch readonly dispid 9; + property responseText: WideString readonly dispid 10; + property responseBody: OleVariant readonly dispid 11; + property responseStream: OleVariant readonly dispid 12; + property readyState: Integer readonly dispid 13; + property onreadystatechange: IDispatch writeonly dispid 14; + end; + +// *********************************************************************// +// Interface : IXMLDSOControl +// Indicateurs : (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID : {310AFA62-0575-11D2-9CA9-0060B0EC3D39} +// *********************************************************************// + IXMLDSOControl = interface(IDispatch) + ['{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'] + function Get_XMLDocument: IXMLDOMDocument; safecall; + procedure Set_XMLDocument(const ppDoc: IXMLDOMDocument); safecall; + function Get_JavaDSOCompatible: Integer; safecall; + procedure Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); safecall; + function Get_readyState: Integer; safecall; + property XMLDocument: IXMLDOMDocument read Get_XMLDocument write Set_XMLDocument; + property JavaDSOCompatible: Integer read Get_JavaDSOCompatible write Set_JavaDSOCompatible; + property readyState: Integer read Get_readyState; + end; + +// *********************************************************************// +// DispIntf: IXMLDSOControlDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {310AFA62-0575-11D2-9CA9-0060B0EC3D39} +// *********************************************************************// + IXMLDSOControlDisp = dispinterface + ['{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'] + property XMLDocument: IXMLDOMDocument dispid 65537; + property JavaDSOCompatible: Integer dispid 65538; + property readyState: Integer readonly dispid -525; + end; + +// *********************************************************************// +// Interface : IXMLElementCollection +// Indicateurs : (4432) Hidden Dual OleAutomation Dispatchable +// GUID : {65725580-9B5D-11D0-9BFE-00C04FC99C8E} +// *********************************************************************// + IXMLElementCollection = interface(IDispatch) + ['{65725580-9B5D-11D0-9BFE-00C04FC99C8E}'] + procedure Set_length(p: Integer); safecall; + function Get_length: Integer; safecall; + function Get__newEnum: IUnknown; safecall; + function item(var1: OleVariant; var2: OleVariant): IDispatch; safecall; + property length: Integer read Get_length write Set_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLElementCollectionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {65725580-9B5D-11D0-9BFE-00C04FC99C8E} +// *********************************************************************// + IXMLElementCollectionDisp = dispinterface + ['{65725580-9B5D-11D0-9BFE-00C04FC99C8E}'] + property length: Integer dispid 65537; + property _newEnum: IUnknown readonly dispid -4; + function item(var1: OleVariant; var2: OleVariant): IDispatch; dispid 65539; + end; + +// *********************************************************************// +// Interface : IXMLDocument +// Indicateurs : (4432) Hidden Dual OleAutomation Dispatchable +// GUID : {F52E2B61-18A1-11D1-B105-00805F49916B} +// *********************************************************************// + IXMLDocument = interface(IDispatch) + ['{F52E2B61-18A1-11D1-B105-00805F49916B}'] + function Get_root: IXMLElement; safecall; + function Get_fileSize: WideString; safecall; + function Get_fileModifiedDate: WideString; safecall; + function Get_fileUpdatedDate: WideString; safecall; + function Get_url: WideString; safecall; + procedure Set_url(const p: WideString); safecall; + function Get_mimeType: WideString; safecall; + function Get_readyState: Integer; safecall; + function Get_charset: WideString; safecall; + procedure Set_charset(const p: WideString); safecall; + function Get_version: WideString; safecall; + function Get_doctype: WideString; safecall; + function Get_dtdURL: WideString; safecall; + function createElement(vType: OleVariant; var1: OleVariant): IXMLElement; safecall; + property root: IXMLElement read Get_root; + property fileSize: WideString read Get_fileSize; + property fileModifiedDate: WideString read Get_fileModifiedDate; + property fileUpdatedDate: WideString read Get_fileUpdatedDate; + property url: WideString read Get_url write Set_url; + property mimeType: WideString read Get_mimeType; + property readyState: Integer read Get_readyState; + property charset: WideString read Get_charset write Set_charset; + property version: WideString read Get_version; + property doctype: WideString read Get_doctype; + property dtdURL: WideString read Get_dtdURL; + end; + +// *********************************************************************// +// DispIntf: IXMLDocumentDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F52E2B61-18A1-11D1-B105-00805F49916B} +// *********************************************************************// + IXMLDocumentDisp = dispinterface + ['{F52E2B61-18A1-11D1-B105-00805F49916B}'] + property root: IXMLElement readonly dispid 65637; + property fileSize: WideString readonly dispid 65638; + property fileModifiedDate: WideString readonly dispid 65639; + property fileUpdatedDate: WideString readonly dispid 65640; + property url: WideString dispid 65641; + property mimeType: WideString readonly dispid 65642; + property readyState: Integer readonly dispid 65643; + property charset: WideString dispid 65645; + property version: WideString readonly dispid 65646; + property doctype: WideString readonly dispid 65647; + property dtdURL: WideString readonly dispid 65648; + function createElement(vType: OleVariant; var1: OleVariant): IXMLElement; dispid 65644; + end; + +// *********************************************************************// +// Interface : IXMLElement +// Indicateurs : (4432) Hidden Dual OleAutomation Dispatchable +// GUID : {3F7F31AC-E15F-11D0-9C25-00C04FC99C8E} +// *********************************************************************// + IXMLElement = interface(IDispatch) + ['{3F7F31AC-E15F-11D0-9C25-00C04FC99C8E}'] + function Get_tagName: WideString; safecall; + procedure Set_tagName(const p: WideString); safecall; + function Get_parent: IXMLElement; safecall; + procedure setAttribute(const strPropertyName: WideString; PropertyValue: OleVariant); safecall; + function getAttribute(const strPropertyName: WideString): OleVariant; safecall; + procedure removeAttribute(const strPropertyName: WideString); safecall; + function Get_children: IXMLElementCollection; safecall; + function Get_type_: Integer; safecall; + function Get_text: WideString; safecall; + procedure Set_text(const p: WideString); safecall; + procedure addChild(const pChildElem: IXMLElement; lIndex: Integer; lReserved: Integer); safecall; + procedure removeChild(const pChildElem: IXMLElement); safecall; + property tagName: WideString read Get_tagName write Set_tagName; + property parent: IXMLElement read Get_parent; + property children: IXMLElementCollection read Get_children; + property type_: Integer read Get_type_; + property text: WideString read Get_text write Set_text; + end; + +// *********************************************************************// +// DispIntf: IXMLElementDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3F7F31AC-E15F-11D0-9C25-00C04FC99C8E} +// *********************************************************************// + IXMLElementDisp = dispinterface + ['{3F7F31AC-E15F-11D0-9C25-00C04FC99C8E}'] + property tagName: WideString dispid 65737; + property parent: IXMLElement readonly dispid 65738; + procedure setAttribute(const strPropertyName: WideString; PropertyValue: OleVariant); dispid 65739; + function getAttribute(const strPropertyName: WideString): OleVariant; dispid 65740; + procedure removeAttribute(const strPropertyName: WideString); dispid 65741; + property children: IXMLElementCollection readonly dispid 65742; + property type_: Integer readonly dispid 65743; + property text: WideString dispid 65744; + procedure addChild(const pChildElem: IXMLElement; lIndex: Integer; lReserved: Integer); dispid 65745; + procedure removeChild(const pChildElem: IXMLElement); dispid 65746; + end; + +// *********************************************************************// +// Interface : IXMLDocument2 +// Indicateurs : (4112) Hidden Dispatchable +// GUID : {2B8DE2FE-8D2D-11D1-B2FC-00C04FD915A9} +// *********************************************************************// + IXMLDocument2 = interface(IDispatch) + ['{2B8DE2FE-8D2D-11D1-B2FC-00C04FD915A9}'] + function Get_root(out p: IXMLElement2): HResult; stdcall; + function Get_fileSize(out p: WideString): HResult; stdcall; + function Get_fileModifiedDate(out p: WideString): HResult; stdcall; + function Get_fileUpdatedDate(out p: WideString): HResult; stdcall; + function Get_url(out p: WideString): HResult; stdcall; + function Set_url(const p: WideString): HResult; stdcall; + function Get_mimeType(out p: WideString): HResult; stdcall; + function Get_readyState(out pl: Integer): HResult; stdcall; + function Get_charset(out p: WideString): HResult; stdcall; + function Set_charset(const p: WideString): HResult; stdcall; + function Get_version(out p: WideString): HResult; stdcall; + function Get_doctype(out p: WideString): HResult; stdcall; + function Get_dtdURL(out p: WideString): HResult; stdcall; + function createElement(vType: OleVariant; var1: OleVariant; out ppElem: IXMLElement2): HResult; stdcall; + function Get_async(out pf: WordBool): HResult; stdcall; + function Set_async(pf: WordBool): HResult; stdcall; + end; + +// *********************************************************************// +// Interface : IXMLElement2 +// Indicateurs : (4432) Hidden Dual OleAutomation Dispatchable +// GUID : {2B8DE2FF-8D2D-11D1-B2FC-00C04FD915A9} +// *********************************************************************// + IXMLElement2 = interface(IDispatch) + ['{2B8DE2FF-8D2D-11D1-B2FC-00C04FD915A9}'] + function Get_tagName: WideString; safecall; + procedure Set_tagName(const p: WideString); safecall; + function Get_parent: IXMLElement2; safecall; + procedure setAttribute(const strPropertyName: WideString; PropertyValue: OleVariant); safecall; + function getAttribute(const strPropertyName: WideString): OleVariant; safecall; + procedure removeAttribute(const strPropertyName: WideString); safecall; + function Get_children: IXMLElementCollection; safecall; + function Get_type_: Integer; safecall; + function Get_text: WideString; safecall; + procedure Set_text(const p: WideString); safecall; + procedure addChild(const pChildElem: IXMLElement2; lIndex: Integer; lReserved: Integer); safecall; + procedure removeChild(const pChildElem: IXMLElement2); safecall; + function Get_attributes: IXMLElementCollection; safecall; + property tagName: WideString read Get_tagName write Set_tagName; + property parent: IXMLElement2 read Get_parent; + property children: IXMLElementCollection read Get_children; + property type_: Integer read Get_type_; + property text: WideString read Get_text write Set_text; + property attributes: IXMLElementCollection read Get_attributes; + end; + +// *********************************************************************// +// DispIntf: IXMLElement2Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2B8DE2FF-8D2D-11D1-B2FC-00C04FD915A9} +// *********************************************************************// + IXMLElement2Disp = dispinterface + ['{2B8DE2FF-8D2D-11D1-B2FC-00C04FD915A9}'] + property tagName: WideString dispid 65737; + property parent: IXMLElement2 readonly dispid 65738; + procedure setAttribute(const strPropertyName: WideString; PropertyValue: OleVariant); dispid 65739; + function getAttribute(const strPropertyName: WideString): OleVariant; dispid 65740; + procedure removeAttribute(const strPropertyName: WideString); dispid 65741; + property children: IXMLElementCollection readonly dispid 65742; + property type_: Integer readonly dispid 65743; + property text: WideString dispid 65744; + procedure addChild(const pChildElem: IXMLElement2; lIndex: Integer; lReserved: Integer); dispid 65745; + procedure removeChild(const pChildElem: IXMLElement2); dispid 65746; + property attributes: IXMLElementCollection readonly dispid 65747; + end; + +// *********************************************************************// +// Interface : IXMLAttribute +// Indicateurs : (4432) Hidden Dual OleAutomation Dispatchable +// GUID : {D4D4A0FC-3B73-11D1-B2B4-00C04FB92596} +// *********************************************************************// + IXMLAttribute = interface(IDispatch) + ['{D4D4A0FC-3B73-11D1-B2B4-00C04FB92596}'] + function Get_name: WideString; safecall; + function Get_value: WideString; safecall; + property name: WideString read Get_name; + property value: WideString read Get_value; + end; + +// *********************************************************************// +// DispIntf: IXMLAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D4D4A0FC-3B73-11D1-B2B4-00C04FB92596} +// *********************************************************************// + IXMLAttributeDisp = dispinterface + ['{D4D4A0FC-3B73-11D1-B2B4-00C04FB92596}'] + property name: WideString readonly dispid 65937; + property value: WideString readonly dispid 65938; + end; + +// *********************************************************************// +// Interface : IXMLError +// Indicateurs : (16) Hidden +// GUID : {948C5AD3-C58D-11D0-9C0B-00C04FC99C8E} +// *********************************************************************// + IXMLError = interface(IUnknown) + ['{948C5AD3-C58D-11D0-9C0B-00C04FC99C8E}'] + function GetErrorInfo(var pErrorReturn: _xml_error): HResult; stdcall; + end; + +// *********************************************************************// +// La classe CoDOMDocument fournit une méthode Create et CreateRemote pour +// créer des instances de l'interface par défaut IXMLDOMDocument exposée +// pas la CoClass DOMDocument. Les fonctions sont destinées à être utilisées par +// les clients désirant automatiser les objets CoClass exposés par +// le serveur de cette bibliothèque de types. +// *********************************************************************// + CoDOMDocument = class + class function Create: IXMLDOMDocument; + class function CreateRemote(const MachineName: string): IXMLDOMDocument; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de serveur OLE +// Objet serveur : TDOMDocument +// Chaîne d'aide : W3C-DOM XML Document +// Interface par défaut : IXMLDOMDocument +// DISP Int. Déf. ? : No +// Interface événements : XMLDOMDocumentEvents +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TDOMDocumentProperties= class; +{$ENDIF} + TDOMDocument = class(TOleServer) + private + FOnondataavailable: TNotifyEvent; + FOnonreadystatechange: TNotifyEvent; + FIntf: IXMLDOMDocument; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TDOMDocumentProperties; + function GetServerProperties: TDOMDocumentProperties; +{$ENDIF} + function GetDefaultInterface: IXMLDOMDocument; + protected + procedure InitServerData; override; + procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override; + function Get_doctype: IXMLDOMDocumentType; + function Get_implementation_: IXMLDOMImplementation; + function Get_documentElement: IXMLDOMElement; + procedure Set_documentElement(const DOMElement: IXMLDOMElement); + function Get_readyState: Integer; + function Get_parseError: IXMLDOMParseError; + function Get_url: WideString; + function Get_async: WordBool; + procedure Set_async(isAsync: WordBool); + function Get_validateOnParse: WordBool; + procedure Set_validateOnParse(isValidating: WordBool); + function Get_resolveExternals: WordBool; + procedure Set_resolveExternals(isResolving: WordBool); + function Get_preserveWhiteSpace: WordBool; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); + procedure Set_onreadystatechange(Param1: OleVariant); + procedure Set_ondataavailable(Param1: OleVariant); + procedure Set_ontransformnode(Param1: OleVariant); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IXMLDOMDocument); + procedure Disconnect; override; + function createElement(const tagName: WideString): IXMLDOMElement; + function createDocumentFragment: IXMLDOMDocumentFragment; + function createTextNode(const data: WideString): IXMLDOMText; + function createComment(const data: WideString): IXMLDOMComment; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; + function createAttribute(const name: WideString): IXMLDOMAttribute; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; + function nodeFromID(const idString: WideString): IXMLDOMNode; + function load(xmlSource: OleVariant): WordBool; + procedure abort; + function loadXML(const bstrXML: WideString): WordBool; + procedure save(destination: OleVariant); + property DefaultInterface: IXMLDOMDocument read GetDefaultInterface; + property doctype: IXMLDOMDocumentType read Get_doctype; + property implementation_: IXMLDOMImplementation read Get_implementation_; + property documentElement: IXMLDOMElement read Get_documentElement write Set_documentElement; + property readyState: Integer read Get_readyState; + property parseError: IXMLDOMParseError read Get_parseError; + property url: WideString read Get_url; + property onreadystatechange: OleVariant write Set_onreadystatechange; + property ondataavailable: OleVariant write Set_ondataavailable; + property ontransformnode: OleVariant write Set_ontransformnode; + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TDOMDocumentProperties read GetServerProperties; +{$ENDIF} + property Onondataavailable: TNotifyEvent read FOnondataavailable write FOnondataavailable; + property Ononreadystatechange: TNotifyEvent read FOnonreadystatechange write FOnonreadystatechange; + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// Classe proxy Propriétés Serveur OLE +// Objet serveur : TDOMDocument +// (Cet objet est utilisé pas l'inspecteur de propriété de l'EDI pour la +// modification des propriétés de ce serveur) +// *********************************************************************// + TDOMDocumentProperties = class(TPersistent) + private + FServer: TDOMDocument; + function GetDefaultInterface: IXMLDOMDocument; + constructor Create(AServer: TDOMDocument); + protected + function Get_doctype: IXMLDOMDocumentType; + function Get_implementation_: IXMLDOMImplementation; + function Get_documentElement: IXMLDOMElement; + procedure Set_documentElement(const DOMElement: IXMLDOMElement); + function Get_readyState: Integer; + function Get_parseError: IXMLDOMParseError; + function Get_url: WideString; + function Get_async: WordBool; + procedure Set_async(isAsync: WordBool); + function Get_validateOnParse: WordBool; + procedure Set_validateOnParse(isValidating: WordBool); + function Get_resolveExternals: WordBool; + procedure Set_resolveExternals(isResolving: WordBool); + function Get_preserveWhiteSpace: WordBool; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); + procedure Set_onreadystatechange(Param1: OleVariant); + procedure Set_ondataavailable(Param1: OleVariant); + procedure Set_ontransformnode(Param1: OleVariant); + public + property DefaultInterface: IXMLDOMDocument read GetDefaultInterface; + published + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + end; +{$ENDIF} + + +// *********************************************************************// +// La classe CoDOMFreeThreadedDocument fournit une méthode Create et CreateRemote pour +// créer des instances de l'interface par défaut IXMLDOMDocument exposée +// pas la CoClass DOMFreeThreadedDocument. Les fonctions sont destinées à être utilisées par +// les clients désirant automatiser les objets CoClass exposés par +// le serveur de cette bibliothèque de types. +// *********************************************************************// + CoDOMFreeThreadedDocument = class + class function Create: IXMLDOMDocument; + class function CreateRemote(const MachineName: string): IXMLDOMDocument; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de serveur OLE +// Objet serveur : TDOMFreeThreadedDocument +// Chaîne d'aide : W3C-DOM XML Document (Apartment) +// Interface par défaut : IXMLDOMDocument +// DISP Int. Déf. ? : No +// Interface événements : XMLDOMDocumentEvents +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TDOMFreeThreadedDocumentProperties= class; +{$ENDIF} + TDOMFreeThreadedDocument = class(TOleServer) + private + FOnondataavailable: TNotifyEvent; + FOnonreadystatechange: TNotifyEvent; + FIntf: IXMLDOMDocument; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TDOMFreeThreadedDocumentProperties; + function GetServerProperties: TDOMFreeThreadedDocumentProperties; +{$ENDIF} + function GetDefaultInterface: IXMLDOMDocument; + protected + procedure InitServerData; override; + procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override; + function Get_doctype: IXMLDOMDocumentType; + function Get_implementation_: IXMLDOMImplementation; + function Get_documentElement: IXMLDOMElement; + procedure Set_documentElement(const DOMElement: IXMLDOMElement); + function Get_readyState: Integer; + function Get_parseError: IXMLDOMParseError; + function Get_url: WideString; + function Get_async: WordBool; + procedure Set_async(isAsync: WordBool); + function Get_validateOnParse: WordBool; + procedure Set_validateOnParse(isValidating: WordBool); + function Get_resolveExternals: WordBool; + procedure Set_resolveExternals(isResolving: WordBool); + function Get_preserveWhiteSpace: WordBool; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); + procedure Set_onreadystatechange(Param1: OleVariant); + procedure Set_ondataavailable(Param1: OleVariant); + procedure Set_ontransformnode(Param1: OleVariant); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IXMLDOMDocument); + procedure Disconnect; override; + function createElement(const tagName: WideString): IXMLDOMElement; + function createDocumentFragment: IXMLDOMDocumentFragment; + function createTextNode(const data: WideString): IXMLDOMText; + function createComment(const data: WideString): IXMLDOMComment; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; + function createAttribute(const name: WideString): IXMLDOMAttribute; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; + function nodeFromID(const idString: WideString): IXMLDOMNode; + function load(xmlSource: OleVariant): WordBool; + procedure abort; + function loadXML(const bstrXML: WideString): WordBool; + procedure save(destination: OleVariant); + property DefaultInterface: IXMLDOMDocument read GetDefaultInterface; + property doctype: IXMLDOMDocumentType read Get_doctype; + property implementation_: IXMLDOMImplementation read Get_implementation_; + property documentElement: IXMLDOMElement read Get_documentElement write Set_documentElement; + property readyState: Integer read Get_readyState; + property parseError: IXMLDOMParseError read Get_parseError; + property url: WideString read Get_url; + property onreadystatechange: OleVariant write Set_onreadystatechange; + property ondataavailable: OleVariant write Set_ondataavailable; + property ontransformnode: OleVariant write Set_ontransformnode; + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TDOMFreeThreadedDocumentProperties read GetServerProperties; +{$ENDIF} + property Onondataavailable: TNotifyEvent read FOnondataavailable write FOnondataavailable; + property Ononreadystatechange: TNotifyEvent read FOnonreadystatechange write FOnonreadystatechange; + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// Classe proxy Propriétés Serveur OLE +// Objet serveur : TDOMFreeThreadedDocument +// (Cet objet est utilisé pas l'inspecteur de propriété de l'EDI pour la +// modification des propriétés de ce serveur) +// *********************************************************************// + TDOMFreeThreadedDocumentProperties = class(TPersistent) + private + FServer: TDOMFreeThreadedDocument; + function GetDefaultInterface: IXMLDOMDocument; + constructor Create(AServer: TDOMFreeThreadedDocument); + protected + function Get_doctype: IXMLDOMDocumentType; + function Get_implementation_: IXMLDOMImplementation; + function Get_documentElement: IXMLDOMElement; + procedure Set_documentElement(const DOMElement: IXMLDOMElement); + function Get_readyState: Integer; + function Get_parseError: IXMLDOMParseError; + function Get_url: WideString; + function Get_async: WordBool; + procedure Set_async(isAsync: WordBool); + function Get_validateOnParse: WordBool; + procedure Set_validateOnParse(isValidating: WordBool); + function Get_resolveExternals: WordBool; + procedure Set_resolveExternals(isResolving: WordBool); + function Get_preserveWhiteSpace: WordBool; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); + procedure Set_onreadystatechange(Param1: OleVariant); + procedure Set_ondataavailable(Param1: OleVariant); + procedure Set_ontransformnode(Param1: OleVariant); + public + property DefaultInterface: IXMLDOMDocument read GetDefaultInterface; + published + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + end; +{$ENDIF} + + +// *********************************************************************// +// La classe CoXMLHTTPRequest fournit une méthode Create et CreateRemote pour +// créer des instances de l'interface par défaut IXMLHttpRequest exposée +// pas la CoClass XMLHTTPRequest. Les fonctions sont destinées à être utilisées par +// les clients désirant automatiser les objets CoClass exposés par +// le serveur de cette bibliothèque de types. +// *********************************************************************// + CoXMLHTTPRequest = class + class function Create: IXMLHttpRequest; + class function CreateRemote(const MachineName: string): IXMLHttpRequest; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de serveur OLE +// Objet serveur : TXMLHTTPRequest +// Chaîne d'aide : XML HTTP Request class. +// Interface par défaut : IXMLHttpRequest +// DISP Int. Déf. ? : No +// Interface événements : +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TXMLHTTPRequestProperties= class; +{$ENDIF} + TXMLHTTPRequest = class(TOleServer) + private + FIntf: IXMLHttpRequest; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TXMLHTTPRequestProperties; + function GetServerProperties: TXMLHTTPRequestProperties; +{$ENDIF} + function GetDefaultInterface: IXMLHttpRequest; + protected + procedure InitServerData; override; + function Get_status: Integer; + function Get_statusText: WideString; + function Get_responseXML: IDispatch; + function Get_responseText: WideString; + function Get_responseBody: OleVariant; + function Get_responseStream: OleVariant; + function Get_readyState: Integer; + procedure Set_onreadystatechange(const Param1: IDispatch); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IXMLHttpRequest); + procedure Disconnect; override; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString); overload; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant); overload; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant); overload; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); overload; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); + function getResponseHeader(const bstrHeader: WideString): WideString; + function getAllResponseHeaders: WideString; + procedure send; overload; + procedure send(varBody: OleVariant); overload; + procedure abort; + property DefaultInterface: IXMLHttpRequest read GetDefaultInterface; + property status: Integer read Get_status; + property statusText: WideString read Get_statusText; + property responseXML: IDispatch read Get_responseXML; + property responseText: WideString read Get_responseText; + property responseBody: OleVariant read Get_responseBody; + property responseStream: OleVariant read Get_responseStream; + property readyState: Integer read Get_readyState; + property onreadystatechange: IDispatch write Set_onreadystatechange; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TXMLHTTPRequestProperties read GetServerProperties; +{$ENDIF} + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// Classe proxy Propriétés Serveur OLE +// Objet serveur : TXMLHTTPRequest +// (Cet objet est utilisé pas l'inspecteur de propriété de l'EDI pour la +// modification des propriétés de ce serveur) +// *********************************************************************// + TXMLHTTPRequestProperties = class(TPersistent) + private + FServer: TXMLHTTPRequest; + function GetDefaultInterface: IXMLHttpRequest; + constructor Create(AServer: TXMLHTTPRequest); + protected + function Get_status: Integer; + function Get_statusText: WideString; + function Get_responseXML: IDispatch; + function Get_responseText: WideString; + function Get_responseBody: OleVariant; + function Get_responseStream: OleVariant; + function Get_readyState: Integer; + procedure Set_onreadystatechange(const Param1: IDispatch); + public + property DefaultInterface: IXMLHttpRequest read GetDefaultInterface; + published + end; +{$ENDIF} + + +// *********************************************************************// +// La classe CoXMLDSOControl fournit une méthode Create et CreateRemote pour +// créer des instances de l'interface par défaut IXMLDSOControl exposée +// pas la CoClass XMLDSOControl. Les fonctions sont destinées à être utilisées par +// les clients désirant automatiser les objets CoClass exposés par +// le serveur de cette bibliothèque de types. +// *********************************************************************// + CoXMLDSOControl = class + class function Create: IXMLDSOControl; + class function CreateRemote(const MachineName: string): IXMLDSOControl; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de serveur OLE +// Objet serveur : TXMLDSOControl +// Chaîne d'aide : XML Data Source Object +// Interface par défaut : IXMLDSOControl +// DISP Int. Déf. ? : No +// Interface événements : +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TXMLDSOControlProperties= class; +{$ENDIF} + TXMLDSOControl = class(TOleServer) + private + FIntf: IXMLDSOControl; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TXMLDSOControlProperties; + function GetServerProperties: TXMLDSOControlProperties; +{$ENDIF} + function GetDefaultInterface: IXMLDSOControl; + protected + procedure InitServerData; override; + function Get_XMLDocument: IXMLDOMDocument; + procedure Set_XMLDocument(const ppDoc: IXMLDOMDocument); + function Get_JavaDSOCompatible: Integer; + procedure Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); + function Get_readyState: Integer; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IXMLDSOControl); + procedure Disconnect; override; + property DefaultInterface: IXMLDSOControl read GetDefaultInterface; + property readyState: Integer read Get_readyState; + property XMLDocument: IXMLDOMDocument read Get_XMLDocument write Set_XMLDocument; + property JavaDSOCompatible: Integer read Get_JavaDSOCompatible write Set_JavaDSOCompatible; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TXMLDSOControlProperties read GetServerProperties; +{$ENDIF} + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// Classe proxy Propriétés Serveur OLE +// Objet serveur : TXMLDSOControl +// (Cet objet est utilisé pas l'inspecteur de propriété de l'EDI pour la +// modification des propriétés de ce serveur) +// *********************************************************************// + TXMLDSOControlProperties = class(TPersistent) + private + FServer: TXMLDSOControl; + function GetDefaultInterface: IXMLDSOControl; + constructor Create(AServer: TXMLDSOControl); + protected + function Get_XMLDocument: IXMLDOMDocument; + procedure Set_XMLDocument(const ppDoc: IXMLDOMDocument); + function Get_JavaDSOCompatible: Integer; + procedure Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); + function Get_readyState: Integer; + public + property DefaultInterface: IXMLDSOControl read GetDefaultInterface; + published + property XMLDocument: IXMLDOMDocument read Get_XMLDocument write Set_XMLDocument; + property JavaDSOCompatible: Integer read Get_JavaDSOCompatible write Set_JavaDSOCompatible; + end; +{$ENDIF} + + +// *********************************************************************// +// La classe CoXMLDocument fournit une méthode Create et CreateRemote pour +// créer des instances de l'interface par défaut IXMLDocument2 exposée +// pas la CoClass XMLDocument. Les fonctions sont destinées à être utilisées par +// les clients désirant automatiser les objets CoClass exposés par +// le serveur de cette bibliothèque de types. +// *********************************************************************// + CoXMLDocument = class + class function Create: IXMLDocument2; + class function CreateRemote(const MachineName: string): IXMLDocument2; + end; + + +// *********************************************************************// +// Déclaration de classe proxy de serveur OLE +// Objet serveur : TXMLDocument +// Chaîne d'aide : XMLDocument extends IXML Document. It is obsolete. You should use DOMDocument. This object should not be confused with the XMLDocument property on the XML data island. +// Interface par défaut : IXMLDocument2 +// DISP Int. Déf. ? : No +// Interface événements : +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TXMLDocumentProperties= class; +{$ENDIF} + TXMLDocument = class(TOleServer) + private + FIntf: IXMLDocument2; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TXMLDocumentProperties; + function GetServerProperties: TXMLDocumentProperties; +{$ENDIF} + function GetDefaultInterface: IXMLDocument2; + protected + procedure InitServerData; override; + function Get_root(out p: IXMLElement2): HResult; + function Get_url(out p: WideString): HResult; + function Set_url(const p: WideString): HResult; + function Get_readyState(out pl: Integer): HResult; + function Get_charset(out p: WideString): HResult; + function Set_charset(const p: WideString): HResult; + function Get_version(out p: WideString): HResult; + function Get_doctype(out p: WideString): HResult; + function Get_async(out pf: WordBool): HResult; + function Set_async(pf: WordBool): HResult; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IXMLDocument2); + procedure Disconnect; override; + function createElement(vType: OleVariant; var1: OleVariant; out ppElem: IXMLElement2): HResult; + property DefaultInterface: IXMLDocument2 read GetDefaultInterface; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TXMLDocumentProperties read GetServerProperties; +{$ENDIF} + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// Classe proxy Propriétés Serveur OLE +// Objet serveur : TXMLDocument +// (Cet objet est utilisé pas l'inspecteur de propriété de l'EDI pour la +// modification des propriétés de ce serveur) +// *********************************************************************// + TXMLDocumentProperties = class(TPersistent) + private + FServer: TXMLDocument; + function GetDefaultInterface: IXMLDocument2; + constructor Create(AServer: TXMLDocument); + protected + function Get_root(out p: IXMLElement2): HResult; + function Get_url(out p: WideString): HResult; + function Set_url(const p: WideString): HResult; + function Get_readyState(out pl: Integer): HResult; + function Get_charset(out p: WideString): HResult; + function Set_charset(const p: WideString): HResult; + function Get_version(out p: WideString): HResult; + function Get_doctype(out p: WideString): HResult; + function Get_async(out pf: WordBool): HResult; + function Set_async(pf: WordBool): HResult; + public + property DefaultInterface: IXMLDocument2 read GetDefaultInterface; + published + end; +{$ENDIF} + + +procedure Register; + +implementation + +uses ComObj; + +class function CoDOMDocument.Create: IXMLDOMDocument; +begin + Result := CreateComObject(CLASS_DOMDocument) as IXMLDOMDocument; +end; + +class function CoDOMDocument.CreateRemote(const MachineName: string): IXMLDOMDocument; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument) as IXMLDOMDocument; +end; + +procedure TDOMDocument.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{2933BF90-7B36-11D2-B20E-00C04F983E60}'; + IntfIID: '{2933BF81-7B36-11D2-B20E-00C04F983E60}'; + EventIID: '{3EFAA427-272F-11D2-836F-0000F87A7782}'; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TDOMDocument.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + ConnectEvents(punk); + Fintf:= punk as IXMLDOMDocument; + end; +end; + +procedure TDOMDocument.ConnectTo(svrIntf: IXMLDOMDocument); +begin + Disconnect; + FIntf := svrIntf; + ConnectEvents(FIntf); +end; + +procedure TDOMDocument.DisConnect; +begin + if Fintf <> nil then + begin + DisconnectEvents(FIntf); + FIntf := nil; + end; +end; + +function TDOMDocument.GetDefaultInterface: IXMLDOMDocument; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler ''Connect'' ou ''ConnectTo'' avant cette opération'); + Result := FIntf; +end; + +constructor TDOMDocument.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TDOMDocumentProperties.Create(Self); +{$ENDIF} +end; + +destructor TDOMDocument.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TDOMDocument.GetServerProperties: TDOMDocumentProperties; +begin + Result := FProps; +end; +{$ENDIF} + +procedure TDOMDocument.InvokeEvent(DispID: TDispID; var Params: TVariantArray); +begin + case DispID of + -1: Exit; // DISPID_UNKNOWN + 198: if Assigned(FOnondataavailable) then + FOnondataavailable(Self); + -609: if Assigned(FOnonreadystatechange) then + FOnonreadystatechange(Self); + end; {case DispID} +end; + +function TDOMDocument.Get_doctype: IXMLDOMDocumentType; +begin + Result := DefaultInterface.Get_doctype; +end; + +function TDOMDocument.Get_implementation_: IXMLDOMImplementation; +begin + Result := DefaultInterface.Get_implementation_; +end; + +function TDOMDocument.Get_documentElement: IXMLDOMElement; +begin + Result := DefaultInterface.Get_documentElement; +end; + +procedure TDOMDocument.Set_documentElement(const DOMElement: IXMLDOMElement); +begin + DefaultInterface.Set_documentElement(DOMElement); +end; + +function TDOMDocument.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +function TDOMDocument.Get_parseError: IXMLDOMParseError; +begin + Result := DefaultInterface.Get_parseError; +end; + +function TDOMDocument.Get_url: WideString; +begin + Result := DefaultInterface.Get_url; +end; + +function TDOMDocument.Get_async: WordBool; +begin + Result := DefaultInterface.Get_async; +end; + +procedure TDOMDocument.Set_async(isAsync: WordBool); +begin + DefaultInterface.Set_async(isAsync); +end; + +function TDOMDocument.Get_validateOnParse: WordBool; +begin + Result := DefaultInterface.Get_validateOnParse; +end; + +procedure TDOMDocument.Set_validateOnParse(isValidating: WordBool); +begin + DefaultInterface.Set_validateOnParse(isValidating); +end; + +function TDOMDocument.Get_resolveExternals: WordBool; +begin + Result := DefaultInterface.Get_resolveExternals; +end; + +procedure TDOMDocument.Set_resolveExternals(isResolving: WordBool); +begin + DefaultInterface.Set_resolveExternals(isResolving); +end; + +function TDOMDocument.Get_preserveWhiteSpace: WordBool; +begin + Result := DefaultInterface.Get_preserveWhiteSpace; +end; + +procedure TDOMDocument.Set_preserveWhiteSpace(isPreserving: WordBool); +begin + DefaultInterface.Set_preserveWhiteSpace(isPreserving); +end; + +procedure TDOMDocument.Set_onreadystatechange(Param1: OleVariant); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +procedure TDOMDocument.Set_ondataavailable(Param1: OleVariant); +begin + DefaultInterface.Set_ondataavailable(Param1); +end; + +procedure TDOMDocument.Set_ontransformnode(Param1: OleVariant); +begin + DefaultInterface.Set_ontransformnode(Param1); +end; + +function TDOMDocument.createElement(const tagName: WideString): IXMLDOMElement; +begin + Result := DefaultInterface.createElement(tagName); +end; + +function TDOMDocument.createDocumentFragment: IXMLDOMDocumentFragment; +begin + Result := DefaultInterface.createDocumentFragment; +end; + +function TDOMDocument.createTextNode(const data: WideString): IXMLDOMText; +begin + Result := DefaultInterface.createTextNode(data); +end; + +function TDOMDocument.createComment(const data: WideString): IXMLDOMComment; +begin + Result := DefaultInterface.createComment(data); +end; + +function TDOMDocument.createCDATASection(const data: WideString): IXMLDOMCDATASection; +begin + Result := DefaultInterface.createCDATASection(data); +end; + +function TDOMDocument.createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; +begin + Result := DefaultInterface.createProcessingInstruction(target, data); +end; + +function TDOMDocument.createAttribute(const name: WideString): IXMLDOMAttribute; +begin + Result := DefaultInterface.createAttribute(name); +end; + +function TDOMDocument.createEntityReference(const name: WideString): IXMLDOMEntityReference; +begin + Result := DefaultInterface.createEntityReference(name); +end; + +function TDOMDocument.getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; +begin + Result := DefaultInterface.getElementsByTagName(tagName); +end; + +function TDOMDocument.createNode(type_: OleVariant; const name: WideString; + const namespaceURI: WideString): IXMLDOMNode; +begin + Result := DefaultInterface.createNode(type_, name, namespaceURI); +end; + +function TDOMDocument.nodeFromID(const idString: WideString): IXMLDOMNode; +begin + Result := DefaultInterface.nodeFromID(idString); +end; + +function TDOMDocument.load(xmlSource: OleVariant): WordBool; +begin + Result := DefaultInterface.load(xmlSource); +end; + +procedure TDOMDocument.abort; +begin + DefaultInterface.abort; +end; + +function TDOMDocument.loadXML(const bstrXML: WideString): WordBool; +begin + Result := DefaultInterface.loadXML(bstrXML); +end; + +procedure TDOMDocument.save(destination: OleVariant); +begin + DefaultInterface.save(destination); +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TDOMDocumentProperties.Create(AServer: TDOMDocument); +begin + inherited Create; + FServer := AServer; +end; + +function TDOMDocumentProperties.GetDefaultInterface: IXMLDOMDocument; +begin + Result := FServer.DefaultInterface; +end; + +function TDOMDocumentProperties.Get_doctype: IXMLDOMDocumentType; +begin + Result := DefaultInterface.Get_doctype; +end; + +function TDOMDocumentProperties.Get_implementation_: IXMLDOMImplementation; +begin + Result := DefaultInterface.Get_implementation_; +end; + +function TDOMDocumentProperties.Get_documentElement: IXMLDOMElement; +begin + Result := DefaultInterface.Get_documentElement; +end; + +procedure TDOMDocumentProperties.Set_documentElement(const DOMElement: IXMLDOMElement); +begin + DefaultInterface.Set_documentElement(DOMElement); +end; + +function TDOMDocumentProperties.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +function TDOMDocumentProperties.Get_parseError: IXMLDOMParseError; +begin + Result := DefaultInterface.Get_parseError; +end; + +function TDOMDocumentProperties.Get_url: WideString; +begin + Result := DefaultInterface.Get_url; +end; + +function TDOMDocumentProperties.Get_async: WordBool; +begin + Result := DefaultInterface.Get_async; +end; + +procedure TDOMDocumentProperties.Set_async(isAsync: WordBool); +begin + DefaultInterface.Set_async(isAsync); +end; + +function TDOMDocumentProperties.Get_validateOnParse: WordBool; +begin + Result := DefaultInterface.Get_validateOnParse; +end; + +procedure TDOMDocumentProperties.Set_validateOnParse(isValidating: WordBool); +begin + DefaultInterface.Set_validateOnParse(isValidating); +end; + +function TDOMDocumentProperties.Get_resolveExternals: WordBool; +begin + Result := DefaultInterface.Get_resolveExternals; +end; + +procedure TDOMDocumentProperties.Set_resolveExternals(isResolving: WordBool); +begin + DefaultInterface.Set_resolveExternals(isResolving); +end; + +function TDOMDocumentProperties.Get_preserveWhiteSpace: WordBool; +begin + Result := DefaultInterface.Get_preserveWhiteSpace; +end; + +procedure TDOMDocumentProperties.Set_preserveWhiteSpace(isPreserving: WordBool); +begin + DefaultInterface.Set_preserveWhiteSpace(isPreserving); +end; + +procedure TDOMDocumentProperties.Set_onreadystatechange(Param1: OleVariant); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +procedure TDOMDocumentProperties.Set_ondataavailable(Param1: OleVariant); +begin + DefaultInterface.Set_ondataavailable(Param1); +end; + +procedure TDOMDocumentProperties.Set_ontransformnode(Param1: OleVariant); +begin + DefaultInterface.Set_ontransformnode(Param1); +end; + +{$ENDIF} + +class function CoDOMFreeThreadedDocument.Create: IXMLDOMDocument; +begin + Result := CreateComObject(CLASS_DOMFreeThreadedDocument) as IXMLDOMDocument; +end; + +class function CoDOMFreeThreadedDocument.CreateRemote(const MachineName: string): IXMLDOMDocument; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMFreeThreadedDocument) as IXMLDOMDocument; +end; + +procedure TDOMFreeThreadedDocument.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{2933BF91-7B36-11D2-B20E-00C04F983E60}'; + IntfIID: '{2933BF81-7B36-11D2-B20E-00C04F983E60}'; + EventIID: '{3EFAA427-272F-11D2-836F-0000F87A7782}'; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TDOMFreeThreadedDocument.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + ConnectEvents(punk); + Fintf:= punk as IXMLDOMDocument; + end; +end; + +procedure TDOMFreeThreadedDocument.ConnectTo(svrIntf: IXMLDOMDocument); +begin + Disconnect; + FIntf := svrIntf; + ConnectEvents(FIntf); +end; + +procedure TDOMFreeThreadedDocument.DisConnect; +begin + if Fintf <> nil then + begin + DisconnectEvents(FIntf); + FIntf := nil; + end; +end; + +function TDOMFreeThreadedDocument.GetDefaultInterface: IXMLDOMDocument; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler ''Connect'' ou ''ConnectTo'' avant cette opération'); + Result := FIntf; +end; + +constructor TDOMFreeThreadedDocument.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TDOMFreeThreadedDocumentProperties.Create(Self); +{$ENDIF} +end; + +destructor TDOMFreeThreadedDocument.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TDOMFreeThreadedDocument.GetServerProperties: TDOMFreeThreadedDocumentProperties; +begin + Result := FProps; +end; +{$ENDIF} + +procedure TDOMFreeThreadedDocument.InvokeEvent(DispID: TDispID; var Params: TVariantArray); +begin + case DispID of + -1: Exit; // DISPID_UNKNOWN + 198: if Assigned(FOnondataavailable) then + FOnondataavailable(Self); + -609: if Assigned(FOnonreadystatechange) then + FOnonreadystatechange(Self); + end; {case DispID} +end; + +function TDOMFreeThreadedDocument.Get_doctype: IXMLDOMDocumentType; +begin + Result := DefaultInterface.Get_doctype; +end; + +function TDOMFreeThreadedDocument.Get_implementation_: IXMLDOMImplementation; +begin + Result := DefaultInterface.Get_implementation_; +end; + +function TDOMFreeThreadedDocument.Get_documentElement: IXMLDOMElement; +begin + Result := DefaultInterface.Get_documentElement; +end; + +procedure TDOMFreeThreadedDocument.Set_documentElement(const DOMElement: IXMLDOMElement); +begin + DefaultInterface.Set_documentElement(DOMElement); +end; + +function TDOMFreeThreadedDocument.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +function TDOMFreeThreadedDocument.Get_parseError: IXMLDOMParseError; +begin + Result := DefaultInterface.Get_parseError; +end; + +function TDOMFreeThreadedDocument.Get_url: WideString; +begin + Result := DefaultInterface.Get_url; +end; + +function TDOMFreeThreadedDocument.Get_async: WordBool; +begin + Result := DefaultInterface.Get_async; +end; + +procedure TDOMFreeThreadedDocument.Set_async(isAsync: WordBool); +begin + DefaultInterface.Set_async(isAsync); +end; + +function TDOMFreeThreadedDocument.Get_validateOnParse: WordBool; +begin + Result := DefaultInterface.Get_validateOnParse; +end; + +procedure TDOMFreeThreadedDocument.Set_validateOnParse(isValidating: WordBool); +begin + DefaultInterface.Set_validateOnParse(isValidating); +end; + +function TDOMFreeThreadedDocument.Get_resolveExternals: WordBool; +begin + Result := DefaultInterface.Get_resolveExternals; +end; + +procedure TDOMFreeThreadedDocument.Set_resolveExternals(isResolving: WordBool); +begin + DefaultInterface.Set_resolveExternals(isResolving); +end; + +function TDOMFreeThreadedDocument.Get_preserveWhiteSpace: WordBool; +begin + Result := DefaultInterface.Get_preserveWhiteSpace; +end; + +procedure TDOMFreeThreadedDocument.Set_preserveWhiteSpace(isPreserving: WordBool); +begin + DefaultInterface.Set_preserveWhiteSpace(isPreserving); +end; + +procedure TDOMFreeThreadedDocument.Set_onreadystatechange(Param1: OleVariant); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +procedure TDOMFreeThreadedDocument.Set_ondataavailable(Param1: OleVariant); +begin + DefaultInterface.Set_ondataavailable(Param1); +end; + +procedure TDOMFreeThreadedDocument.Set_ontransformnode(Param1: OleVariant); +begin + DefaultInterface.Set_ontransformnode(Param1); +end; + +function TDOMFreeThreadedDocument.createElement(const tagName: WideString): IXMLDOMElement; +begin + Result := DefaultInterface.createElement(tagName); +end; + +function TDOMFreeThreadedDocument.createDocumentFragment: IXMLDOMDocumentFragment; +begin + Result := DefaultInterface.createDocumentFragment; +end; + +function TDOMFreeThreadedDocument.createTextNode(const data: WideString): IXMLDOMText; +begin + Result := DefaultInterface.createTextNode(data); +end; + +function TDOMFreeThreadedDocument.createComment(const data: WideString): IXMLDOMComment; +begin + Result := DefaultInterface.createComment(data); +end; + +function TDOMFreeThreadedDocument.createCDATASection(const data: WideString): IXMLDOMCDATASection; +begin + Result := DefaultInterface.createCDATASection(data); +end; + +function TDOMFreeThreadedDocument.createProcessingInstruction(const target: WideString; + const data: WideString): IXMLDOMProcessingInstruction; +begin + Result := DefaultInterface.createProcessingInstruction(target, data); +end; + +function TDOMFreeThreadedDocument.createAttribute(const name: WideString): IXMLDOMAttribute; +begin + Result := DefaultInterface.createAttribute(name); +end; + +function TDOMFreeThreadedDocument.createEntityReference(const name: WideString): IXMLDOMEntityReference; +begin + Result := DefaultInterface.createEntityReference(name); +end; + +function TDOMFreeThreadedDocument.getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; +begin + Result := DefaultInterface.getElementsByTagName(tagName); +end; + +function TDOMFreeThreadedDocument.createNode(type_: OleVariant; const name: WideString; + const namespaceURI: WideString): IXMLDOMNode; +begin + Result := DefaultInterface.createNode(type_, name, namespaceURI); +end; + +function TDOMFreeThreadedDocument.nodeFromID(const idString: WideString): IXMLDOMNode; +begin + Result := DefaultInterface.nodeFromID(idString); +end; + +function TDOMFreeThreadedDocument.load(xmlSource: OleVariant): WordBool; +begin + Result := DefaultInterface.load(xmlSource); +end; + +procedure TDOMFreeThreadedDocument.abort; +begin + DefaultInterface.abort; +end; + +function TDOMFreeThreadedDocument.loadXML(const bstrXML: WideString): WordBool; +begin + Result := DefaultInterface.loadXML(bstrXML); +end; + +procedure TDOMFreeThreadedDocument.save(destination: OleVariant); +begin + DefaultInterface.save(destination); +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TDOMFreeThreadedDocumentProperties.Create(AServer: TDOMFreeThreadedDocument); +begin + inherited Create; + FServer := AServer; +end; + +function TDOMFreeThreadedDocumentProperties.GetDefaultInterface: IXMLDOMDocument; +begin + Result := FServer.DefaultInterface; +end; + +function TDOMFreeThreadedDocumentProperties.Get_doctype: IXMLDOMDocumentType; +begin + Result := DefaultInterface.Get_doctype; +end; + +function TDOMFreeThreadedDocumentProperties.Get_implementation_: IXMLDOMImplementation; +begin + Result := DefaultInterface.Get_implementation_; +end; + +function TDOMFreeThreadedDocumentProperties.Get_documentElement: IXMLDOMElement; +begin + Result := DefaultInterface.Get_documentElement; +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_documentElement(const DOMElement: IXMLDOMElement); +begin + DefaultInterface.Set_documentElement(DOMElement); +end; + +function TDOMFreeThreadedDocumentProperties.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +function TDOMFreeThreadedDocumentProperties.Get_parseError: IXMLDOMParseError; +begin + Result := DefaultInterface.Get_parseError; +end; + +function TDOMFreeThreadedDocumentProperties.Get_url: WideString; +begin + Result := DefaultInterface.Get_url; +end; + +function TDOMFreeThreadedDocumentProperties.Get_async: WordBool; +begin + Result := DefaultInterface.Get_async; +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_async(isAsync: WordBool); +begin + DefaultInterface.Set_async(isAsync); +end; + +function TDOMFreeThreadedDocumentProperties.Get_validateOnParse: WordBool; +begin + Result := DefaultInterface.Get_validateOnParse; +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_validateOnParse(isValidating: WordBool); +begin + DefaultInterface.Set_validateOnParse(isValidating); +end; + +function TDOMFreeThreadedDocumentProperties.Get_resolveExternals: WordBool; +begin + Result := DefaultInterface.Get_resolveExternals; +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_resolveExternals(isResolving: WordBool); +begin + DefaultInterface.Set_resolveExternals(isResolving); +end; + +function TDOMFreeThreadedDocumentProperties.Get_preserveWhiteSpace: WordBool; +begin + Result := DefaultInterface.Get_preserveWhiteSpace; +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_preserveWhiteSpace(isPreserving: WordBool); +begin + DefaultInterface.Set_preserveWhiteSpace(isPreserving); +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_onreadystatechange(Param1: OleVariant); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_ondataavailable(Param1: OleVariant); +begin + DefaultInterface.Set_ondataavailable(Param1); +end; + +procedure TDOMFreeThreadedDocumentProperties.Set_ontransformnode(Param1: OleVariant); +begin + DefaultInterface.Set_ontransformnode(Param1); +end; + +{$ENDIF} + +class function CoXMLHTTPRequest.Create: IXMLHttpRequest; +begin + Result := CreateComObject(CLASS_XMLHTTPRequest) as IXMLHttpRequest; +end; + +class function CoXMLHTTPRequest.CreateRemote(const MachineName: string): IXMLHttpRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTPRequest) as IXMLHttpRequest; +end; + +procedure TXMLHTTPRequest.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{ED8C108E-4349-11D2-91A4-00C04F7969E8}'; + IntfIID: '{ED8C108D-4349-11D2-91A4-00C04F7969E8}'; + EventIID: ''; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TXMLHTTPRequest.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + Fintf:= punk as IXMLHttpRequest; + end; +end; + +procedure TXMLHTTPRequest.ConnectTo(svrIntf: IXMLHttpRequest); +begin + Disconnect; + FIntf := svrIntf; +end; + +procedure TXMLHTTPRequest.DisConnect; +begin + if Fintf <> nil then + begin + FIntf := nil; + end; +end; + +function TXMLHTTPRequest.GetDefaultInterface: IXMLHttpRequest; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler ''Connect'' ou ''ConnectTo'' avant cette opération'); + Result := FIntf; +end; + +constructor TXMLHTTPRequest.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TXMLHTTPRequestProperties.Create(Self); +{$ENDIF} +end; + +destructor TXMLHTTPRequest.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TXMLHTTPRequest.GetServerProperties: TXMLHTTPRequestProperties; +begin + Result := FProps; +end; +{$ENDIF} + +function TXMLHTTPRequest.Get_status: Integer; +begin + Result := DefaultInterface.Get_status; +end; + +function TXMLHTTPRequest.Get_statusText: WideString; +begin + Result := DefaultInterface.Get_statusText; +end; + +function TXMLHTTPRequest.Get_responseXML: IDispatch; +begin + Result := DefaultInterface.Get_responseXML; +end; + +function TXMLHTTPRequest.Get_responseText: WideString; +begin + Result := DefaultInterface.Get_responseText; +end; + +function TXMLHTTPRequest.Get_responseBody: OleVariant; +begin + Result := DefaultInterface.Get_responseBody; +end; + +function TXMLHTTPRequest.Get_responseStream: OleVariant; +begin + Result := DefaultInterface.Get_responseStream; +end; + +function TXMLHTTPRequest.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +procedure TXMLHTTPRequest.Set_onreadystatechange(const Param1: IDispatch); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +procedure TXMLHTTPRequest.open(const bstrMethod: WideString; const bstrUrl: WideString); +begin + DefaultInterface.open(bstrMethod, bstrUrl, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TXMLHTTPRequest.open(const bstrMethod: WideString; const bstrUrl: WideString; + varAsync: OleVariant); +begin + DefaultInterface.open(bstrMethod, bstrUrl, varAsync, EmptyParam, EmptyParam); +end; + +procedure TXMLHTTPRequest.open(const bstrMethod: WideString; const bstrUrl: WideString; + varAsync: OleVariant; bstrUser: OleVariant); +begin + DefaultInterface.open(bstrMethod, bstrUrl, varAsync, bstrUser, EmptyParam); +end; + +procedure TXMLHTTPRequest.open(const bstrMethod: WideString; const bstrUrl: WideString; + varAsync: OleVariant; bstrUser: OleVariant; bstrPassword: OleVariant); +begin + DefaultInterface.open(bstrMethod, bstrUrl, varAsync, bstrUser, bstrPassword); +end; + +procedure TXMLHTTPRequest.setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); +begin + DefaultInterface.setRequestHeader(bstrHeader, bstrValue); +end; + +function TXMLHTTPRequest.getResponseHeader(const bstrHeader: WideString): WideString; +begin + Result := DefaultInterface.getResponseHeader(bstrHeader); +end; + +function TXMLHTTPRequest.getAllResponseHeaders: WideString; +begin + Result := DefaultInterface.getAllResponseHeaders; +end; + +procedure TXMLHTTPRequest.send; +begin + DefaultInterface.send(EmptyParam); +end; + +procedure TXMLHTTPRequest.send(varBody: OleVariant); +begin + DefaultInterface.send(varBody); +end; + +procedure TXMLHTTPRequest.abort; +begin + DefaultInterface.abort; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TXMLHTTPRequestProperties.Create(AServer: TXMLHTTPRequest); +begin + inherited Create; + FServer := AServer; +end; + +function TXMLHTTPRequestProperties.GetDefaultInterface: IXMLHttpRequest; +begin + Result := FServer.DefaultInterface; +end; + +function TXMLHTTPRequestProperties.Get_status: Integer; +begin + Result := DefaultInterface.Get_status; +end; + +function TXMLHTTPRequestProperties.Get_statusText: WideString; +begin + Result := DefaultInterface.Get_statusText; +end; + +function TXMLHTTPRequestProperties.Get_responseXML: IDispatch; +begin + Result := DefaultInterface.Get_responseXML; +end; + +function TXMLHTTPRequestProperties.Get_responseText: WideString; +begin + Result := DefaultInterface.Get_responseText; +end; + +function TXMLHTTPRequestProperties.Get_responseBody: OleVariant; +begin + Result := DefaultInterface.Get_responseBody; +end; + +function TXMLHTTPRequestProperties.Get_responseStream: OleVariant; +begin + Result := DefaultInterface.Get_responseStream; +end; + +function TXMLHTTPRequestProperties.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +procedure TXMLHTTPRequestProperties.Set_onreadystatechange(const Param1: IDispatch); +begin + DefaultInterface.Set_onreadystatechange(Param1); +end; + +{$ENDIF} + +class function CoXMLDSOControl.Create: IXMLDSOControl; +begin + Result := CreateComObject(CLASS_XMLDSOControl) as IXMLDSOControl; +end; + +class function CoXMLDSOControl.CreateRemote(const MachineName: string): IXMLDSOControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLDSOControl) as IXMLDSOControl; +end; + +procedure TXMLDSOControl.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{550DDA30-0541-11D2-9CA9-0060B0EC3D39}'; + IntfIID: '{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'; + EventIID: ''; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TXMLDSOControl.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + Fintf:= punk as IXMLDSOControl; + end; +end; + +procedure TXMLDSOControl.ConnectTo(svrIntf: IXMLDSOControl); +begin + Disconnect; + FIntf := svrIntf; +end; + +procedure TXMLDSOControl.DisConnect; +begin + if Fintf <> nil then + begin + FIntf := nil; + end; +end; + +function TXMLDSOControl.GetDefaultInterface: IXMLDSOControl; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler ''Connect'' ou ''ConnectTo'' avant cette opération'); + Result := FIntf; +end; + +constructor TXMLDSOControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TXMLDSOControlProperties.Create(Self); +{$ENDIF} +end; + +destructor TXMLDSOControl.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TXMLDSOControl.GetServerProperties: TXMLDSOControlProperties; +begin + Result := FProps; +end; +{$ENDIF} + +function TXMLDSOControl.Get_XMLDocument: IXMLDOMDocument; +begin + Result := DefaultInterface.Get_XMLDocument; +end; + +procedure TXMLDSOControl.Set_XMLDocument(const ppDoc: IXMLDOMDocument); +begin + DefaultInterface.Set_XMLDocument(ppDoc); +end; + +function TXMLDSOControl.Get_JavaDSOCompatible: Integer; +begin + Result := DefaultInterface.Get_JavaDSOCompatible; +end; + +procedure TXMLDSOControl.Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); +begin + DefaultInterface.Set_JavaDSOCompatible(fJavaDSOCompatible); +end; + +function TXMLDSOControl.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TXMLDSOControlProperties.Create(AServer: TXMLDSOControl); +begin + inherited Create; + FServer := AServer; +end; + +function TXMLDSOControlProperties.GetDefaultInterface: IXMLDSOControl; +begin + Result := FServer.DefaultInterface; +end; + +function TXMLDSOControlProperties.Get_XMLDocument: IXMLDOMDocument; +begin + Result := DefaultInterface.Get_XMLDocument; +end; + +procedure TXMLDSOControlProperties.Set_XMLDocument(const ppDoc: IXMLDOMDocument); +begin + DefaultInterface.Set_XMLDocument(ppDoc); +end; + +function TXMLDSOControlProperties.Get_JavaDSOCompatible: Integer; +begin + Result := DefaultInterface.Get_JavaDSOCompatible; +end; + +procedure TXMLDSOControlProperties.Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); +begin + DefaultInterface.Set_JavaDSOCompatible(fJavaDSOCompatible); +end; + +function TXMLDSOControlProperties.Get_readyState: Integer; +begin + Result := DefaultInterface.Get_readyState; +end; + +{$ENDIF} + +class function CoXMLDocument.Create: IXMLDocument2; +begin + Result := CreateComObject(CLASS_XMLDocument) as IXMLDocument2; +end; + +class function CoXMLDocument.CreateRemote(const MachineName: string): IXMLDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLDocument) as IXMLDocument2; +end; + +procedure TXMLDocument.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{CFC399AF-D876-11D0-9C10-00C04FC99C8E}'; + IntfIID: '{2B8DE2FE-8D2D-11D1-B2FC-00C04FD915A9}'; + EventIID: ''; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TXMLDocument.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + Fintf:= punk as IXMLDocument2; + end; +end; + +procedure TXMLDocument.ConnectTo(svrIntf: IXMLDocument2); +begin + Disconnect; + FIntf := svrIntf; +end; + +procedure TXMLDocument.DisConnect; +begin + if Fintf <> nil then + begin + FIntf := nil; + end; +end; + +function TXMLDocument.GetDefaultInterface: IXMLDocument2; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler ''Connect'' ou ''ConnectTo'' avant cette opération'); + Result := FIntf; +end; + +constructor TXMLDocument.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TXMLDocumentProperties.Create(Self); +{$ENDIF} +end; + +destructor TXMLDocument.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TXMLDocument.GetServerProperties: TXMLDocumentProperties; +begin + Result := FProps; +end; +{$ENDIF} + +function TXMLDocument.Get_root(out p: IXMLElement2): HResult; +begin + Result := DefaultInterface.Get_root(p); +end; + +function TXMLDocument.Get_url(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_url(p); +end; + +function TXMLDocument.Set_url(const p: WideString): HResult; +begin + Result := DefaultInterface.Set_url(p); +end; + +function TXMLDocument.Get_readyState(out pl: Integer): HResult; +begin + Result := DefaultInterface.Get_readyState(pl); +end; + +function TXMLDocument.Get_charset(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_charset(p); +end; + +function TXMLDocument.Set_charset(const p: WideString): HResult; +begin + Result := DefaultInterface.Set_charset(p); +end; + +function TXMLDocument.Get_version(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_version(p); +end; + +function TXMLDocument.Get_doctype(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_doctype(p); +end; + +function TXMLDocument.Get_async(out pf: WordBool): HResult; +begin + Result := DefaultInterface.Get_async(pf); +end; + +function TXMLDocument.Set_async(pf: WordBool): HResult; +begin + Result := DefaultInterface.Set_async(pf); +end; + +function TXMLDocument.createElement(vType: OleVariant; var1: OleVariant; out ppElem: IXMLElement2): HResult; +begin + Result := DefaultInterface.createElement(vType, var1, ppElem); +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TXMLDocumentProperties.Create(AServer: TXMLDocument); +begin + inherited Create; + FServer := AServer; +end; + +function TXMLDocumentProperties.GetDefaultInterface: IXMLDocument2; +begin + Result := FServer.DefaultInterface; +end; + +function TXMLDocumentProperties.Get_root(out p: IXMLElement2): HResult; +begin + Result := DefaultInterface.Get_root(p); +end; + +function TXMLDocumentProperties.Get_url(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_url(p); +end; + +function TXMLDocumentProperties.Set_url(const p: WideString): HResult; +begin + Result := DefaultInterface.Set_url(p); +end; + +function TXMLDocumentProperties.Get_readyState(out pl: Integer): HResult; +begin + Result := DefaultInterface.Get_readyState(pl); +end; + +function TXMLDocumentProperties.Get_charset(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_charset(p); +end; + +function TXMLDocumentProperties.Set_charset(const p: WideString): HResult; +begin + Result := DefaultInterface.Set_charset(p); +end; + +function TXMLDocumentProperties.Get_version(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_version(p); +end; + +function TXMLDocumentProperties.Get_doctype(out p: WideString): HResult; +begin + Result := DefaultInterface.Get_doctype(p); +end; + +function TXMLDocumentProperties.Get_async(out pf: WordBool): HResult; +begin + Result := DefaultInterface.Get_async(pf); +end; + +function TXMLDocumentProperties.Set_async(pf: WordBool): HResult; +begin + Result := DefaultInterface.Set_async(pf); +end; + +{$ENDIF} + +procedure Register; +begin + RegisterComponents('ActiveX',[TDOMDocument, TDOMFreeThreadedDocument, TXMLHTTPRequest, TXMLDSOControl, + TXMLDocument]); +end; + +end. diff --git a/src/microsoft_agent.dof b/src/microsoft_agent.dof new file mode 100644 index 0000000..e5fef47 --- /dev/null +++ b/src/microsoft_agent.dof @@ -0,0 +1,87 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=0 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=$(DELPHI)\Lib\Debug +Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;ibevnt50;vcldbx50;TeeUI50;TeeDB50;Tee50;TeeQR50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50 +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang=$0000040C +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=1 +MajorVer=1 +MinorVer=0 +Release=0 +Build=1 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 +[Version Info Keys] +CompanyName=Netbusiness +FileDescription= +FileVersion=1.0.0.1 +InternalName= +LegalCopyright=Netbusiness 2001 +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= diff --git a/src/microsoft_agent.dpk b/src/microsoft_agent.dpk new file mode 100644 index 0000000..1c07219 --- /dev/null +++ b/src/microsoft_agent.dpk @@ -0,0 +1,34 @@ +package microsoft_agent; + +{$R *.res} +{$R 'Imports\AgentObjects_TLB.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$IMPLICITBUILD OFF} + +requires + vcl; + +contains + AgentObjects_TLB in 'Imports\AgentObjects_TLB.pas'; + +end. diff --git a/src/microsoft_xml.dof b/src/microsoft_xml.dof new file mode 100644 index 0000000..6c6f193 --- /dev/null +++ b/src/microsoft_xml.dof @@ -0,0 +1,87 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=0 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=$(DELPHI)\Lib\Debug +Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;ibevnt50;vcldbx50;TeeUI50;TeeDB50;Tee50;TeeQR50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50 +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang=$0000040C +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=1 +MajorVer=1 +MinorVer=0 +Release=0 +Build=2 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 +[Version Info Keys] +CompanyName=Netbusiness +FileDescription= +FileVersion=1.0.0.2 +InternalName= +LegalCopyright=Netbusiness 2001 +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= diff --git a/src/microsoft_xml.dpk b/src/microsoft_xml.dpk new file mode 100644 index 0000000..a33b668 --- /dev/null +++ b/src/microsoft_xml.dpk @@ -0,0 +1,34 @@ +package microsoft_xml; + +{$R *.res} +{$R 'Imports\MSXML_TLB.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$IMPLICITBUILD OFF} + +requires + vcl; + +contains + MSXML_TLB in 'Imports\MSXML_TLB.pas'; + +end. diff --git a/src/uAjaxAnimation.pas b/src/uAjaxAnimation.pas new file mode 100644 index 0000000..04e36c4 --- /dev/null +++ b/src/uAjaxAnimation.pas @@ -0,0 +1,64 @@ +unit uAjaxAnimation; + +// (c) Patrick Prémartin / Olf Software 02/2017 + +interface + +uses + fmx.objects; + +procedure ajax_animation_set(zone: TRectangle); +procedure ajax_animation_on; +procedure ajax_animation_off(reinitialiser: boolean = false); + +implementation + +var + compteur: integer; + zoneAjax: TRectangle; + +procedure ajax_animation_set(zone: TRectangle); +begin + zoneAjax := zone; +end; + +procedure ajax_animation_on; +begin + if Assigned(zoneAjax) then + begin + if (compteur < 1) then + begin + compteur := 1; + zoneAjax.visible := true; + zoneAjax.BringToFront; + end + else + inc(compteur); + end; +end; + +procedure ajax_animation_off(reinitialiser: boolean = false); +begin + if Assigned(zoneAjax) then + begin + if reinitialiser then + begin + compteur := 0; + zoneAjax.visible := false; + end + else if (compteur > 1) then + dec(compteur) + else + begin + compteur := 0; + zoneAjax.visible := false; + end; + end; +end; + +initialization + +compteur := 0; +zoneAjax := nil; + +end. diff --git a/src/uChecksumVerif.pas b/src/uChecksumVerif.pas new file mode 100644 index 0000000..c571d16 --- /dev/null +++ b/src/uChecksumVerif.pas @@ -0,0 +1,108 @@ +unit uChecksumVerif; + +interface + +uses + system.classes; + +type + TChecksumVerifParamList = class(TStrings) + function addParam(ch: string): TChecksumVerifParamList; + end; + + ChecksumVerif = class + private + class function get(param: string; key1: string; key2: string; key3: string; + key4: string; key5: string; isPublic: boolean): string; overload; + public + class function get(param: TChecksumVerifParamList; key1: string = ''; + key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): string; overload; + class function get(param: string; key1: string = ''; key2: string = ''; + key3: string = ''; key4: string = ''; key5: string = ''): string; + overload; + class function check(verif: string; param: TChecksumVerifParamList; + key1: string = ''; key2: string = ''; key3: string = ''; + key4: string = ''; key5: string = ''): boolean; overload; + class function check(verif: string; param: string; key1: string = ''; + key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): boolean; overload; + end; + +implementation + +uses u_md5; + +class function ChecksumVerif.get(param: string; key1: string; key2: string; + key3: string; key4: string; key5: string; isPublic: boolean): string; +var + verif: string; +begin + verif := MD5(param + key1 + key2 + key3 + key4 + key5); + if isPublic then + result := copy(verif, 1 + random(Length(verif) - 10), 10) + else + result := verif; +end; + +class function ChecksumVerif.get(param: TChecksumVerifParamList; + key1: string = ''; key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): string; +var + i: integer; + ch: string; +begin + ch := ''; + for i := 0 to param.Count - 1 do + begin + ch := ch + param[i]; + end; + result := get(ch, key1, key2, key3, key4, key5, true); + param.Free; +end; + +class function ChecksumVerif.get(param: string; key1: string = ''; + key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): string; +begin + result := get(param, key1, key2, key3, key4, key5, true); +end; + +class function ChecksumVerif.check(verif: string; param: TChecksumVerifParamList; + key1: string = ''; key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): boolean; +var + i: integer; + ch: string; +begin + ch := ''; + for i := 0 to param.Count - 1 do + begin + ch := ch + param[i]; + end; + result := check(verif, ch, key1, key2, key3, key4, key5); +end; + +class function ChecksumVerif.check(verif: string; param: string; + key1: string = ''; key2: string = ''; key3: string = ''; key4: string = ''; + key5: string = ''): boolean; +var + verif_: string; +begin + verif_ := get(param, key1, key2, key3, key4, key5, false); + result := 0 < pos(verif, verif_); +end; + +{ TChecksumVerifParamList } + +function TChecksumVerifParamList.addParam(ch: string): TChecksumVerifParamList; +begin + add(ch); + result := self; +end; + +initialization + +randomize; + +end. diff --git a/src/uDivers.pas b/src/uDivers.pas new file mode 100644 index 0000000..99d0b47 --- /dev/null +++ b/src/uDivers.pas @@ -0,0 +1,25 @@ +unit uDivers; + +// (c) Patrick Prémartin / Olf Software 05/2016 + +interface + +uses + FMX.Forms; + +procedure intervertir_affichage(fiche_actuelle, fiche_a_activer: TForm); + +implementation + +procedure intervertir_affichage(fiche_actuelle, fiche_a_activer: TForm); +begin + fiche_a_activer.Caption := fiche_actuelle.Caption; + fiche_a_activer.Left := fiche_actuelle.Left; + fiche_a_activer.Top := fiche_actuelle.Top; + fiche_a_activer.Width := fiche_actuelle.Width; + fiche_a_activer.Height := fiche_actuelle.Height; + fiche_a_activer.Show; + fiche_actuelle.Hide; +end; + +end. diff --git a/src/uGetDeviceName.pas b/src/uGetDeviceName.pas new file mode 100644 index 0000000..ee572bc --- /dev/null +++ b/src/uGetDeviceName.pas @@ -0,0 +1,77 @@ +unit uGetDeviceName; + +interface + +function getDeviceName: string; + +implementation + +{$IF Defined(MSWINDOWS)} + +uses system.sysutils; +{$ELSEIF Defined(IOS)} + +uses + iOSapi.CocoaTypes, iOSapi.Foundation, Macapi.ObjectiveC, Macapi.helpers; + +type + UIDeviceClass = interface(NSObjectClass) + ['{A2DCE998-BF3A-4AB0-9B8D-4182B341C9DF}'] + function currentDevice: Pointer; cdecl; + end; + + UIDevice = interface(NSObject) + ['{70BB371D-314A-4BA9-912E-2EF72EB0F558}'] + function localizedModel: NSString; cdecl; + function model: NSString; cdecl; + function name: NSString; cdecl; + function systemName: NSString; cdecl; + function systemVersion: NSString; cdecl; + function uniqueIdentifier: NSString; cdecl; + end; + + TUIDevice = class(TOCGenericImport) + end; +{$ELSEIF Defined(MACOS)} + +uses Macapi.Foundation, Macapi.helpers; +{$ELSEIF Defined(ANDROID)} + +uses Androidapi.JNI.Os, Androidapi.JNI.Provider, Androidapi.helpers; +{$ENDIF} + +function getDeviceName: string; +{$IF Defined(IOS)} +var + hote: UIDevice; +{$ELSEIF Defined(MACOS)} +var + hote: NSHost; +{$ENDIF} +begin +{$IF Defined(MSWINDOWS)} + Result := GetEnvironmentVariable('COMPUTERNAME'); + if ('' = Result) then + Result := GetEnvironmentVariable('HOSTNAME'); +{$ELSEIF Defined(IOS)} + hote := TUIDevice.Create; + Result := NSStrToStr(hote.name); +{$ELSEIF Defined(MACOS)} + hote := tnshost.Create; + Result := NSStrToStr(hote.localizedName); +{$ELSEIF Defined(ANDROID)} + Result := JStringToString(TJSettings_Secure.JavaClass.getString + (TAndroidHelper.ContentResolver, StringToJString('bluetooth_name'))); + if ('' = Result) then + Result := JStringToString(TJSettings_Global.JavaClass.getString + (TAndroidHelper.ContentResolver, StringToJString('device_name'))); + if ('' = Result) then + Result := JStringToString(tjbuild.JavaClass.model); + if ('' = Result) then + Result := JStringToString(tjbuild.JavaClass.DISPLAY); +{$ELSE} + Result := GetEnvironmentVariable('HOSTNAME'); +{$ENDIF} +end; + +end. diff --git a/src/uKeyboardSpecialKeyTest.pas b/src/uKeyboardSpecialKeyTest.pas new file mode 100644 index 0000000..c5b3ff2 --- /dev/null +++ b/src/uKeyboardSpecialKeyTest.pas @@ -0,0 +1,173 @@ +unit uKeyboardSpecialKeyTest; +{ + ********** + * Test d'appui des touches spéciales du clavier + ********** + + Liste des modifications : + 04/04/2017, Patrick Prémartin (Olf Software) : version Windows/Mac du programme (utilisable en VCL et Firemonkey) + 28/08/2023, pprem : updated for iOS/Android and Linux +} + +interface + +type + tKeyboardSpecialKeyTestPosition = (Left, Right, All, Any); + + tKeyboardSpecialKeyTest = class + class function isAltDown(Position + : tKeyboardSpecialKeyTestPosition = Any): Boolean; + class function isCtrlDown(Position + : tKeyboardSpecialKeyTestPosition = Any): Boolean; + class function isShiftDown(Position + : tKeyboardSpecialKeyTestPosition = Any): Boolean; + class function isWindowsDown(Position + : tKeyboardSpecialKeyTestPosition = Any): Boolean; + class function isCommandDown(Position + : tKeyboardSpecialKeyTestPosition = Any): Boolean; + end; + +implementation + +{$IF Defined(MSWINDOWS)} + +uses windows; +{$ELSEIF Defined(IOS)} +{$ELSEIF Defined(MACOS)} + +uses macapi.appkit; +{$ELSEIF Defined(ANDROID)} +{$ELSEIF Defined(LINUX)} +{$ENDIF} + +type + tKeyboardSpecialKeyTestKeycode = (Alt, Shift, Ctrl, windows, command); + +function isKeyDown(key: tKeyboardSpecialKeyTestKeycode; + Position: tKeyboardSpecialKeyTestPosition): Boolean; +{$IF Defined(MSWINDOWS)} +{$ELSEIF Defined(IOS)} +{$ELSEIF Defined(MACOS)} +{$ELSEIF Defined(ANDROID)} +{$ELSEIF Defined(LINUX)} +{$ENDIF} +begin + result := false; +{$IF Defined(MSWINDOWS)} + case Position of + Left: + case key of + Alt: + result := (getKeyState(VK_LMENU) < 0); + Shift: + result := (getKeyState(VK_LSHIFT) < 0); + Ctrl: + result := (getKeyState(VK_LCONTROL) < 0); + windows: + result := (getKeyState(VK_LWIN) < 0); + end; + Right: + case key of + Alt: + result := (getKeyState(VK_RMENU) < 0); + Shift: + result := (getKeyState(VK_RSHIFT) < 0); + Ctrl: + result := (getKeyState(VK_RCONTROL) < 0); + windows: + result := (getKeyState(VK_RWIN) < 0); + end; + Any: + case key of + Alt: + result := (getKeyState(VK_MENU) < 0); + Shift: + result := (getKeyState(VK_SHIFT) < 0); + Ctrl: + result := (getKeyState(VK_CONTROL) < 0); + windows: + result := (getKeyState(VK_LWIN) < 0) or (getKeyState(VK_RWIN) < 0); + end; + All: + case key of + Alt: + result := (getKeyState(VK_LMENU) < 0) and (getKeyState(VK_RMENU) < 0); + Shift: + result := (getKeyState(VK_LSHIFT) < 0) and + (getKeyState(VK_RSHIFT) < 0); + Ctrl: + result := (getKeyState(VK_LCONTROL) < 0) and + (getKeyState(VK_RCONTROL) < 0); + windows: + result := (getKeyState(VK_LWIN) < 0) and (getKeyState(VK_RWIN) < 0); + end; + end; +{$ELSEIF Defined(IOS)} + // non géré +{$ELSEIF Defined(MACOS)} + // non géré +// Event := TNSEvent.Create; +// if (Event.modifierFlags <> 0) then +// result := true +// else +// result := false; +{$ELSEIF Defined(ANDROID)} + // non géré +{$ELSEIF Defined(LINUX)} + // non géré +{$ENDIF} +end; + +{ tKeyboardSpecialKeyTest } + +class function tKeyboardSpecialKeyTest.isAltDown + (Position: tKeyboardSpecialKeyTestPosition): Boolean; +begin + result := isKeyDown(tKeyboardSpecialKeyTestKeycode.Alt, Position); +end; + +class function tKeyboardSpecialKeyTest.isCommandDown + (Position: tKeyboardSpecialKeyTestPosition): Boolean; +begin +{$IF Defined(MSWINDOWS)} + result := isWindowsDown(Position); +{$ELSEIF Defined(IOS)} +result := false; +{$ELSEIF Defined(MACOS)} + result := isKeyDown(tKeyboardSpecialKeyTestKeycode.command, Position); +{$ELSEIF Defined(ANDROID)} +result := false; +{$ELSEIF Defined(LINUX)} +result := false; +{$ENDIF} +end; + +class function tKeyboardSpecialKeyTest.isCtrlDown + (Position: tKeyboardSpecialKeyTestPosition): Boolean; +begin + result := isKeyDown(tKeyboardSpecialKeyTestKeycode.Ctrl, Position); +end; + +class function tKeyboardSpecialKeyTest.isShiftDown + (Position: tKeyboardSpecialKeyTestPosition): Boolean; +begin + result := isKeyDown(tKeyboardSpecialKeyTestKeycode.Shift, Position); +end; + +class function tKeyboardSpecialKeyTest.isWindowsDown + (Position: tKeyboardSpecialKeyTestPosition): Boolean; +begin +{$IF Defined(MSWINDOWS)} + result := isKeyDown(tKeyboardSpecialKeyTestKeycode.windows, Position); +{$ELSEIF Defined(IOS)} +result := false; +{$ELSEIF Defined(MACOS)} + result := isCommandDown(Position); +{$ELSEIF Defined(ANDROID)} +result := false; +{$ELSEIF Defined(LINUX)} +result := false; +{$ENDIF} +end; + +end. diff --git a/src/uParam.pas b/src/uParam.pas new file mode 100644 index 0000000..3bf181c --- /dev/null +++ b/src/uParam.pas @@ -0,0 +1,58 @@ +unit uParam; +{ + Gestion automatisée d'un fichier de stockage sous forme de dictionnaire de + données (clé / valeur) pour les logiciels développés sous Delphi. + + Logiciel open source distribué sous licence MIT. + Open source software distributed under the MIT license + + Copyright Patrick Prémartin / Olf Software + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + SOFTWARE. + + Find the original source code on + https://github.com/DeveloppeurPascal/librairies + + Find explanations on + https://developpeur-pascal.fr/plutot-ini-ou-json-pour-stocker-vos-parametres.html + + Liste des mises à jour : + => 11/05/2020, Patrick Prémartin : + * ajout de la notice de copyright et licence d'utilisation + * gestion de données de types Syngle et TDataTime + * correction d'une perte de mémoire au niveau du remplacement d'une valeur sur un paramètre existant + => 22/04/2022, Patrick PRémartin : + * ajout de la procédure setFolderName() pour permettre la modification du dossier de stockage du fichier de paramètres + => 19/05/2022, Patrick Prémartin : + * depréciation de cette unité au profit de l'unité Olf.RTL.Params +} + +interface + +uses + Olf.RTL.Params; + +type + TParams = Olf.RTL.Params.TParams; + +implementation + +{$MESSAGE WARN 'uParam unit is deprecated. Use Olf.RTL.Params unit instead.'} + +end. diff --git a/src/u_AnalysePageHTML.pas b/src/u_AnalysePageHTML.pas new file mode 100644 index 0000000..9f88df2 --- /dev/null +++ b/src/u_AnalysePageHTML.pas @@ -0,0 +1,199 @@ +unit u_AnalysePageHTML; +{ +Cette unité fourni des fonctions et procédures permettant d'interpréter une page +HTML et d'y modifier les éventuels tags. + +(c) Patrick Prémartin 21/05/2000 + +Site : https://developpeur-pascal.fr +} + +// (c) Patrick Prémartin / Olf Software 06/2002 + +interface + +type + TTag_Action = (rien, effacer, remplacer); + Ttag_traitement_proc = procedure (tag, instruction_html: string; var action: TTag_Action; var nouveau_tag: string); + +procedure tag_traiter_fichier (nom_fichier_html: string; proc: Ttag_traitement_proc); overload; + +procedure tag_traiter_page (var contenu_fichier: string; proc: Ttag_traitement_proc); overload; + +function tag_nom_instruction (tag: string): string; + +function tag_valeur (tag, nom_param: string): string; + +implementation + +uses + Classes, SysUtils; + +procedure tag_traiter_fichier (nom_fichier_html: string; proc: Ttag_traitement_proc); +var + contenu_fichier: string; + liste: TSTringList; +begin + contenu_fichier := ''; + liste := TStringList.Create; + try + liste.LoadFromFile (nom_fichier_html); + contenu_fichier := liste.Text; + tag_traiter_page (contenu_fichier, proc); + liste.Text := contenu_fichier; + liste.SaveToFile (nom_fichier_html); + finally + liste.Free; + end; +end; + +procedure tag_traiter(var contenu_fichier: string; tag: string; tag_debut, tag_fin: integer; var position_dans_source: integer; var proc: Ttag_traitement_proc); +var + i: integer; + sortie : boolean; + action_a_faire: TTag_Action; + Nouveau_Tag : string; +begin + tag := UpperCase (tag); + + // on enlève les espaces éventuels de début de tag + sortie := false; + i := 1; + while not ((i = length (tag)) or (sortie)) do + if (tag [i] = ' ') then + delete (tag, i, 1) + else if (tag [i] in ['0'..'9', 'A'..'Z']) then + sortie := true + else + inc (i); + {endif} + {endwhile} + + if ((copy (tag, 2, 1) >= '0') { tag de début ou seul } + or ((copy (tag, 2, 1) = '/') and (copy (tag, 3, 1) >= '0'))) {tag de fin } then begin + + if (assigned (proc)) then begin + proc (tag, tag_nom_instruction (tag), action_a_faire, nouveau_tag); + case action_a_faire of + effacer: begin + position_dans_source := pred (tag_debut); + while ((contenu_fichier[tag_fin+1]=#13) or (contenu_fichier[tag_fin+1]=#10)) do + inc (tag_fin); + {endwhile} + delete (contenu_fichier, tag_debut, succ (tag_fin - tag_debut)); + end; + remplacer: begin + delete (contenu_fichier, tag_debut, succ (tag_fin - tag_debut)); + insert (nouveau_tag, contenu_fichier, tag_debut); + position_dans_source := pred (tag_debut+length (nouveau_tag)); + end; + end; + end; + end; +end; + +procedure tag_traiter_page (var contenu_fichier: string; proc: Ttag_traitement_proc); +var + i : integer; + tag: string; + c: char; + tag_on: boolean; + tag_debut, tag_fin : integer; +begin + tag := ''; + tag_on := false; + i := 0; + while (i < length (contenu_fichier)) do begin + inc (i); + c := contenu_fichier [i]; + if tag_on then begin + if (c = '>') then begin + tag := tag + '>'; + tag_fin := i; + tag_traiter (contenu_fichier, tag, tag_debut, tag_fin, i, proc); + tag_on := false; + end else if (c >= ' ') then begin + tag := tag + c; + end else + tag := tag + ' '; + {endif} + end else if (c = '<') then begin + tag_on := true; + tag_debut := i; + tag := '<'; + end; + end; + tag := 'Ce texte est exclusivement réservé aux lecteurs adultes consentants'; + i := pos (tag, contenu_fichier); + if (i > 0) then begin + delete (contenu_fichier, i, length (tag)); + insert ('Ce texte est exclusivement réservé aux lecteurs adultes consentants', contenu_fichier, i); + end; +end; + +function tag_nom_instruction(tag: string): string; +var + i : integer; + ch : string; + en_cours: boolean; + sortie: boolean; + fin_de_tag : boolean; +begin + tag := UpperCase (tag); + en_cours := false; + sortie:= false; + fin_de_tag := false; + i := 0; + while ((i < length (tag)) and (not sortie)) do begin + inc (i); + if ((tag [i] = '/') and (not en_cours)) then + fin_de_tag := true; + {endif} + if (tag [i] in ['0'..'9', 'A'..'Z']) then + if (en_cours) then + ch := ch + tag [i] + else begin + en_cours := true; + ch := tag [i]; + end + else + sortie := en_cours; + {endif} + end; + if fin_de_tag then + ch := '/'+ch; + {endif} + result := ch; +end; + +function tag_valeur(tag, nom_param: string): string; +var + ch : string; + n : integer; + i : integer; + fin : set of char; +begin + tag := UpperCase (tag); + nom_param := UpperCase (nom_param); + ch := ''; + n := pos (nom_param, tag); + if (n > 0) then begin + i := n + length (nom_param); + while ((i < length (tag)) and (tag [i] in [' ', '='])) do + inc (i); + {endwhile} + if (tag [i] = '"') then begin + fin := ['"']; + inc (i); + end else + fin := [' ', '>']; + {endif} + while ((i < length (tag)) and not (tag [i] in fin)) do begin + ch := ch + tag [i]; + inc (i); + end; + end; + result := ch; +end; + +end. diff --git a/src/u_GenerationUtilitaire.pas b/src/u_GenerationUtilitaire.pas new file mode 100644 index 0000000..3590e6c --- /dev/null +++ b/src/u_GenerationUtilitaire.pas @@ -0,0 +1,253 @@ +unit u_GenerationUtilitaire; + +// (c) Patrick Prémartin / Olf Software 12/2000 + +interface + +uses + db; + +function changer_accents (ch : string) : string; +function compression_blancs (ch : string) : string; +function remplacer_marqueur_fichier (var ch : string; tab: tdataset; marqueur, nom_zone: string): boolean; +function modifier_texte_javascript (ch : string) : string; +function URL_Encode (url: string): string; + +implementation + +uses + SysUtils; + +function URL_Encode (url: string): string; +var + n : longint; + ch : string; +begin + ch := ''; + for n := 1 to length (url) do + case url [n] of + #32: ch := ch + '+'; + #33..#47, #58..#64, #91..#96, #123..#255: ch := ch + '%' + format ('%x', [ord (url [n])]); + else + ch := ch + url [n]; + end; + {endfor} + result := ch; +end; + +function changer_accents (ch : string) : string; +var + n : longint; +begin + n := pos ('& ', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'&'+copy (ch, succ (n), length (ch)-n); + n := pos ('& ', ch); + end; + {endwhile} + n := pos ('<', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'<'+copy (ch, succ (n), length (ch)-n); + n := pos ('<', ch); + end; + {endwhile} + n := pos ('>', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'>'+copy (ch, succ (n), length (ch)-n); + n := pos ('>', ch); + end; + {endwhile} + n := pos (#$d, ch); + while (n > 0) do + begin + delete (ch, n, 1); + n := pos (#$d, ch); + end; + {endwhile} + n := pos (#$a#$a, ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'
 '+copy (ch, succ (n), length (ch)-n); + n := pos (#$a, ch); + end; + {endwhile} + n := pos (#$a, ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'
'+copy (ch, succ (n), length (ch)-n); + n := pos (#$a, ch); + end; + {endwhile} + n := pos ('â', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'â'+copy (ch, succ (n), length (ch)-n); + n := pos ('â', ch); + end; + {endwhile} + n := pos ('à', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'à'+copy (ch, succ (n), length (ch)-n); + n := pos ('à', ch); + end; + {endwhile} + n := pos ('ä', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ä'+copy (ch, succ (n), length (ch)-n); + n := pos ('ä', ch); + end; + {endwhile} + n := pos ('é', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'é'+copy (ch, succ (n), length (ch)-n); + n := pos ('é', ch); + end; + {endwhile} + n := pos ('ê', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ê'+copy (ch, succ (n), length (ch)-n); + n := pos ('ê', ch); + end; + {endwhile} + n := pos ('è', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'è'+copy (ch, succ (n), length (ch)-n); + n := pos ('è', ch); + end; + {endwhile} + n := pos ('ë', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ë'+copy (ch, succ (n), length (ch)-n); + n := pos ('ë', ch); + end; + {endwhile} + n := pos ('î', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'î'+copy (ch, succ (n), length (ch)-n); + n := pos ('î', ch); + end; + {endwhile} + n := pos ('ï', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ï'+copy (ch, succ (n), length (ch)-n); + n := pos ('ï', ch); + end; + {endwhile} + n := pos ('ô', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ô'+copy (ch, succ (n), length (ch)-n); + n := pos ('ô', ch); + end; + {endwhile} + n := pos ('ö', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ö'+copy (ch, succ (n), length (ch)-n); + n := pos ('ö', ch); + end; + {endwhile} + n := pos ('û', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'û'+copy (ch, succ (n), length (ch)-n); + n := pos ('û', ch); + end; + {endwhile} + n := pos ('ù', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ù'+copy (ch, succ (n), length (ch)-n); + n := pos ('ù', ch); + end; + {endwhile} + n := pos ('ü', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ü'+copy (ch, succ (n), length (ch)-n); + n := pos ('ü', ch); + end; + {endwhile} + n := pos ('ç', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'ç'+copy (ch, succ (n), length (ch)-n); + n := pos ('ç', ch); + end; + {endwhile} + n := pos ('"', ch); + while (n > 0) do + begin + ch := copy (ch, 1, pred (n))+'"'+copy (ch, succ (n), length (ch)-n); + n := pos ('"', ch); + end; + {endwhile} + Result := ch; +end; { Changer_Accents } + +function compression_blancs (ch : string) : string; +begin + while ((length (ch) > 0) and (ch [length (ch)] = ' ')) do + delete (ch, length (ch), 1); + {endwhile} + Result := ch; +end; { Compression_Blancs } + +function remplacer_marqueur_fichier (var ch : string; tab: tdataset; marqueur, nom_zone: string): boolean; +var + n : Integer; + res: string; +begin +// writeln (marqueur, ':', nom_zone, '
'); + result := false; + n := pos (UpperCase (marqueur), UpperCase (ch)); + if (n > 0) + then + begin + result := true; + delete (ch, n, length (marqueur)); + if (Tab.FieldByName (Nom_Zone).DataType = ftCurrency) + then + res := FormatFloat ('#####0.00', Tab.FieldByName (Nom_Zone).AsFloat) + else + res := Compression_blancs (Tab.FieldByName (Nom_Zone).AsString); + {endif} + if ((copy (marqueur, length (marqueur) - 4, 3) = ' JS') or (copy (marqueur, length (marqueur) - 2, 3) = ' JS')) + then + ch := copy (ch, 1, pred (n))+modifier_texte_javascript (Changer_Accents (res))+copy (ch, n, succ (length (ch)-n)) + else + ch := copy (ch, 1, pred (n))+Changer_Accents (res)+copy (ch, n, succ (length (ch)-n)); + {endif} + end; + {endif} +end; { Remplacer_Marqueur_Fichier } + +function modifier_texte_javascript (ch : string) : string; +var + Res : string; + i : longint; +begin + res := ''; + for i := 1 to length (ch) do + case ch [i] of + '''' : res := res + '\'''; + '\' : res := res + '\\'; + else + res := res + ch [i]; + end; + {endfor} + Result := res; +end; + +end. diff --git a/src/u_android_media_scanner.pas b/src/u_android_media_scanner.pas new file mode 100644 index 0000000..2544b76 --- /dev/null +++ b/src/u_android_media_scanner.pas @@ -0,0 +1,57 @@ +unit u_android_media_scanner; + +// Cette unité Delphi contient des procedures à utiliser sous Android lorsqu'on +// désire donner accès en USB (MTP) à des fichiers créés depuis une application +// (c) 2016 Patrick Prémartin / Olf Software +// +// Liste des mises à jour : +// 16/06/2016, Patrick Prémartin : mise en production de la version initiale + +interface + +/// Add a file to the media files cache. +/// Call it after creating the file you want to share with USB connected device. +/// absolute path + name of the file to add +procedure android_media_scanner_add_file(filename: string); + +/// Add a folder to the media files cache +/// Call it after creating the folder you want to share with USB connected device. +/// absolute path + name of the folder to add +procedure android_media_scanner_add_folder(foldername: string); + +implementation + +{$IFDEF ANDROID} +uses AndroidApi.JNI.GraphicsContentViewText, AndroidApi.JNI.App, + AndroidApi.JNI.Net, AndroidApi.Helpers; +{$ENDIF} + +procedure android_media_scanner_add_file(filename: string); +{$IFDEF ANDROID} +var + Intent: JIntent; +{$ENDIF} +begin +{$IFDEF ANDROID} + Intent := TJIntent.Create; + Intent.setAction(TJIntent.JavaClass.ACTION_MEDIA_SCANNER_SCAN_FILE); + Intent.setData(StrToJURI('file://' + filename)); + TAndroidHelper.Activity.sendBroadcast(Intent); +{$ENDIF} +end; + +procedure android_media_scanner_add_folder(foldername: string); +{$IFDEF ANDROID} +var + Intent: JIntent; +{$ENDIF} +begin +{$IFDEF ANDROID} + Intent := TJIntent.Create; + Intent.setAction(TJIntent.JavaClass.ACTION_MEDIA_MOUNTED); + Intent.setData(StrToJURI('file://' + foldername)); + TAndroidHelper.Activity.sendBroadcast(Intent); +{$ENDIF} +end; + +end. diff --git a/src/u_compteur_db.pas b/src/u_compteur_db.pas new file mode 100644 index 0000000..0dfcd97 --- /dev/null +++ b/src/u_compteur_db.pas @@ -0,0 +1,83 @@ +unit u_compteur_db; +{******************************************************************************* +Unit: U_Compteur_Reg +Author: Patrick Prémartin (pprem@lenet.net or pprem@infonie.fr) +Date: 29 March 1998 / modified on the 9th april 1998 +Comment: This unit use COMPTEUR.DB (a Paradox Database) for counters. If you use + it, think about the BDE (Borland Database Engine). +*******************************************************************************} +interface + +type + TString80 = String [80]; + +function compteur_add (Application, Code: TString80): Integer; + +implementation + +uses + db, dbTables, FileCtrl, SysUtils; + +var + tab_compteur: TTable; + First_Use : boolean; + +procedure initialisation; +begin + Tab_Compteur := TTable.Create (nil); + Tab_Compteur.Databasename := copy (ExtractFilePath (ParamStr (0)), 1, pred (length (ExtractFilePath (ParamStr (0)))))+'\Donnees'; + if (not DirectoryExists (Tab_Compteur.DatabaseName)) + then + ForceDirectories (Tab_Compteur.DatabaseName); + {endif} + Tab_Compteur.TableName := 'compteur.db'; + if not FileExists (Tab_Compteur.Databasename+'\'+Tab_Compteur.TableName) + then + begin + Tab_Compteur.TableType := ttParadox; + Tab_Compteur.FieldDefs.Clear; + Tab_Compteur.FieldDefs.Add ('Cpt_application', ftString, 80, True); + Tab_Compteur.FieldDefs.Add ('Cpt_code', ftString, 80, True); + Tab_Compteur.FieldDefs.Add ('Cpt_valeur', ftInteger, 0, True); + Tab_Compteur.IndexDefs.Clear; + Tab_Compteur.IndexDefs.Add ('', 'Cpt_application;Cpt_code', [ixPrimary, ixUnique]); + Tab_Compteur.CreateTable; + end; + {endif} + Tab_Compteur.Open; + First_Use := false; +end; { Initialisation } + +function compteur_add (Application, Code: TString80): Integer; +begin + if First_Use + then + Initialisation; + {endif} + if Tab_Compteur.Findkey ([Application, Code]) + then + begin + Tab_Compteur.Edit; + Result := Succ (Tab_Compteur.FieldByName ('Cpt_valeur').AsInteger); + Tab_Compteur.FieldByName ('Cpt_valeur').AsInteger := Result; + Tab_Compteur.Post; + end + else + begin + Tab_Compteur.Insert; + Tab_Compteur.FieldByName ('Cpt_application').AsString := Application; + Tab_Compteur.FieldByName ('Cpt_code').AsString := Code; + Tab_Compteur.FieldByName ('Cpt_valeur').AsInteger := 1; + Tab_Compteur.Post; + Result := 1; + end + {endif} +end; { Compteur_Add } + +initialization + First_Use := True; + +finalization + tab_compteur.free; + +end. diff --git a/src/u_compteur_reg.pas b/src/u_compteur_reg.pas new file mode 100644 index 0000000..d925985 --- /dev/null +++ b/src/u_compteur_reg.pas @@ -0,0 +1,49 @@ +unit u_compteur_reg; +{******************************************************************************* +Unit: U_Compteur_Reg +Author: Patrick Prémartin (pprem@lenet.net or pprem@infonie.fr) +Date: 29 March 1998 +Comment: This unit use Windows registry for counters. +*******************************************************************************} +interface + +type + TString80 = String [80]; + +function compteur_add (Application, Code: TString80): Integer; + +implementation + +uses + Windows, + Registry; + +const + NomDeLaCle : string = '\Software\Olf Software\Counter'; + +var + BaseDeRegistres: TRegistry; + +function compteur_add (Application, Code: TString80): Integer; +var + ch : string; +begin + ch := Application+' * '+Code; + try + Result := BaseDeRegistres.ReadInteger (ch); + except + Result := 0; + end; + inc (Result); + BaseDeRegistres.WriteInteger (ch, Result); +end; { Compteur_Add } + +initialization + BaseDeRegistres := TRegistry.Create; + BaseDeRegistres.RootKey := HKEY_Local_Machine; + BaseDeRegistres.OpenKey (NomDeLaCle, not BaseDeRegistres.KeyExists (NomDeLaCle)); + +finalization + BaseDeRegistres.Free; + +end. diff --git a/src/u_download.pas b/src/u_download.pas new file mode 100644 index 0000000..2a96813 --- /dev/null +++ b/src/u_download.pas @@ -0,0 +1,77 @@ +unit u_download; + +interface + +uses system.SysUtils; + +type + tdownload_file = class(tobject) + class procedure download(from_url, to_filename: string; + success: tproc = nil; error: tproc = nil); + class function temporaryFileName(appName: string): string; + end; + +implementation + +{ download_file } + +uses system.ioutils, system.Net.HttpClient, system.Classes; + +class procedure tdownload_file.download(from_url, to_filename: string; + success: tproc = nil; error: tproc = nil); +begin + tthread.CreateAnonymousThread( + procedure + var + serveur: THTTPClient; + serveur_reponse: IHTTPResponse; + fichier: tfilestream; + begin + try + serveur := THTTPClient.Create; + try + serveur_reponse := serveur.Get(from_url); + if serveur_reponse.StatusCode = 200 then + begin + fichier := tfilestream.Create(to_filename, + fmCreate or fmOpenWrite or fmShareDenyWrite); + try + fichier.CopyFrom(serveur_reponse.ContentStream, + serveur_reponse.ContentStream.Size); + finally + fichier.Free; + end; + if assigned(success) then + tthread.queue(nil, + procedure + begin + success; + end); + end + else + begin + raise Exception.CreateFmt + ('Cannot get distant file. Please contact us or retry later. HTTP %d - %s', + [serveur_reponse.StatusCode, serveur_reponse.StatusText]); + end; + finally + serveur.Free; + end; + except + if assigned(error) then + tthread.queue(nil, + procedure + begin + error; + end); + end; + end).Start; +end; + +class function tdownload_file.temporaryFileName(appName: string): string; +begin + result := tpath.Combine(tpath.gettempPath, + appName + '-' + datetimetotimestamp(now).Time.ToString + '.tmp') +end; + +end. diff --git a/src/u_langue.pas b/src/u_langue.pas new file mode 100644 index 0000000..712e41d --- /dev/null +++ b/src/u_langue.pas @@ -0,0 +1,25 @@ +unit u_langue; + +// (c) Patrick Prémartin / Olf Software 08/2016 +// +// This file is distributed under AGPL license. +// +// Get the latest version at +// https://github.com/DeveloppeurPascal/librairies + +interface + +uses Olf.RTL.Language; + +function GetOSLangID: String; + +implementation + +{$MESSAGE WARN 'u_langue unit is deprecated. Use Olf.RTL.Language unit instead.'} + +function GetOSLangID: String; +begin + result := GetCurrentLanguageISOCode; +end; + +end. diff --git a/src/u_md5.pas b/src/u_md5.pas new file mode 100644 index 0000000..062b3c7 --- /dev/null +++ b/src/u_md5.pas @@ -0,0 +1,27 @@ +unit u_md5; + +interface + +/// Get MD5 code from a string +/// String to encode +/// The function return the MD5 of the S string. +function MD5(S: String): String; + +implementation + +uses + IdHashMessageDigest, System.SysUtils; + +function MD5(S: String): String; +var + ch: string; +begin + with TIdHashMessageDigest5.Create do + begin + ch := HashStringAsHex(S); + DisposeOf; + end; + result := ch.ToLower; +end; + +end. diff --git a/src/u_niveau_bdd.pas b/src/u_niveau_bdd.pas new file mode 100644 index 0000000..d77b40d --- /dev/null +++ b/src/u_niveau_bdd.pas @@ -0,0 +1,73 @@ +unit u_niveau_bdd; +{******************************************************************************* +Unit: U_Niveau_Bdd +Author: Patrick Prémartin (pprem@lenet.net or pprem@infonie.fr) +Date: 15 May 1998 +Comment: This unit copy all Paradox files (*.db) from a folder to an other. +*******************************************************************************} +interface + +procedure Verifier_Niveau_Base_de_Donnees (dossier1, dossier2: string); + +implementation + +uses + Windows, Dialogs, SysUtils, FMXUtils, FileCtrl; + +Function Nom_Fichier_Generique (s : string): string; +var + n : integer; +begin + n := pos ('.', s); + if (n > 0) + then + Result := copy (s, 1, n)+Nom_Fichier_Generique (copy (s, Succ(n), length (s)-n)) + else + Result := '*'; + {endif} +end; { Nom_Fichier_Generique } + +procedure Verifier_Niveau_Base_de_Donnees (dossier1, dossier2: string); +var + f, f2 : TSearchRec; + res: integer; +begin + { On vire le '\' en fin de dossier ! } + while (dossier1 [length (dossier1)] = '\') do delete (dossier1, length (Dossier1), 1); + while (dossier2 [length (dossier2)] = '\') do delete (dossier2, length (Dossier2), 1); + + { Si le dossier de départ n'existe pas, on laisse tomber ! } + if not DirectoryExists (Dossier1) + then + exit; + {endif} + + { Si le dossier d'arrivée n'existe pas, on le crée ! } + if not DirectoryExists (Dossier2) + then + ForceDirectories (dossier2); + {endif} + + res := FindFirst (dossier1+'\*.db', faReadOnly+faArchive, f); + while (res = 0) do + begin + if (not FileExists (dossier2+'\'+f.Name)) + then + begin + res := FindFirst (dossier1+'\'+Nom_Fichier_Generique (ExtractFileName (f.Name)), faReadOnly+faArchive, f2); + while (res = 0) do + begin + CopyFile (dossier1+'\'+f2.Name, Dossier2); + res := FindNext (f2); + end; + {endwhile} + FindClose (f2); + end; + {endif} + res := FindNext (f); + end; + {endwhile} + FindClose (f); +end; { Verifier_Niveau_Base_de_Donnees } + +end. diff --git a/src/u_scores.pas b/src/u_scores.pas new file mode 100644 index 0000000..d4ddbc7 --- /dev/null +++ b/src/u_scores.pas @@ -0,0 +1,22 @@ +unit u_scores; +{ + Stockage automatisé de scores pour jeux vidéos développés sous Delphi. + + Copyright Patrick Prémartin / Olf Software + + Find the original source code on + https://github.com/DeveloppeurPascal/librairies + + This file is deprecated. Use Gamolf.RTL.Scores.pas from https://github.com/DeveloppeurPascal/FMXGameEngine instead. +} +interface + +implementation + +initialization + +{$MESSAGE FATAL 'This file is deprecated. Use Gamolf.RTL.Scores.pas from https://github.com/DeveloppeurPascal/FMXGameEngine instead.'} + +finalization + +end. diff --git a/src/u_urlOpen.pas b/src/u_urlOpen.pas new file mode 100644 index 0000000..dfce01f --- /dev/null +++ b/src/u_urlOpen.pas @@ -0,0 +1,45 @@ +unit u_urlOpen; + +interface + +/// Launch URL website on the default browser +/// Absolute address of the website to open in the web browser +procedure url_Open_In_Browser(URL: string); + +implementation + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, +{$IF Defined(IOS)} +macapi.helpers, iOSapi.Foundation, FMX.Helpers.iOS; +{$ELSEIF Defined(ANDROID)} + Androidapi.JNI.GraphicsContentViewText, + Androidapi.Helpers; +{$ELSEIF Defined(MACOS)} + Posix.Stdlib; +{$ELSEIF Defined(MSWINDOWS)} + Winapi.ShellAPI, Winapi.Windows; +{$ENDIF} + +procedure url_Open_In_Browser(URL: string); +{$IF Defined(ANDROID)} +var + Intent: JIntent; +{$ENDIF} +begin +{$IF Defined(ANDROID)} + Intent := TJIntent.Create; + Intent.setAction(TJIntent.JavaClass.ACTION_VIEW); + Intent.setData(StrToJURI(URL)); + // SharedActivity.startActivity(Intent); + tandroidhelper.Activity.startActivity(Intent); +{$ELSEIF Defined(MSWINDOWS)} + ShellExecute(0, 'OPEN', PWideChar(URL), nil, nil, SW_SHOWNORMAL); +{$ELSEIF Defined(IOS)} + SharedApplication.OpenURL(StrToNSUrl(Url)); +{$ELSEIF Defined(MACOS)} + _system(PAnsiChar('open ' + AnsiString(URL))); +{$ENDIF} +end; + +end. diff --git a/src/u_util.pas b/src/u_util.pas new file mode 100644 index 0000000..044ad8d --- /dev/null +++ b/src/u_util.pas @@ -0,0 +1,57 @@ +unit u_util; + +interface + +function sans_decimal_separator (ch: string): string; + +function sans_les_blancs (ch : string): string; + +function convert_date (date: string): string; + +function convert_heure (heure: string): string; + +implementation + +uses + SysUtils; + +function sans_decimal_separator (ch: string): string; +var + n : integer; +begin + if (DecimalSeparator <> '.') then begin + n := pos (DecimalSeparator, ch); + while (n > 0) do begin + delete (ch, n, Length (DecimalSeparator)); + insert ('.', ch, n); + n := pos (DecimalSeparator, ch); + end; + end; + Result := ch; +end; + +function sans_les_blancs (ch : string): string; +var + ch2 : string; +begin + ch2 := ''; + while (ch > '') do begin + if (ch[1] in ['0'..'9', ',', '.']) then + ch2 := ch2+ch[1]; + {endif} + delete (ch, 1, 1); + end; + Result := ch2; +end; + +function convert_date (date: string): string; +begin + Result := copy (date, 7, 2)+'/'+copy (date, 5, 2)+'/'+copy (date, 1, 4); +end; + +function convert_heure (heure: string): string; +begin + Result := copy (heure, 1, 2)+':'+copy (heure, 3, 2)+':'+copy (heure, 5, 2); +end; + +end. diff --git a/src/u_version.pas b/src/u_version.pas new file mode 100644 index 0000000..b8e8b52 --- /dev/null +++ b/src/u_version.pas @@ -0,0 +1,63 @@ +unit u_version; + +interface + +function GetApplicationVersion: string; +function GetFileVersion(aFileName : String; var Found : Boolean) : String; + +implementation + +uses + SysUtils, windows; + +function GetApplicationVersion: string; +var + trouve : boolean; +begin + result := GetFileVersion (ParamStr (0), trouve); +end; + +function GetFileVersion(aFileName : String; var Found : Boolean) : String; +var + woMajorVersion, woMinorVersion, woSubVersion, woBuildNumber : Word; + doInfoSize, doVersionSize : LongWord; +{$IFDEF VER100} + Wnd : Integer; +{$ELSE} + Wnd : Cardinal; +{$ENDIF} + ptVersion : Pointer; + ptFixedFileInfo : PVSFixedFileInfo; + s : String; +begin + s := ''; + aFileName := ExtractFileName(aFileName); + doInfoSize := GetFileVersionInfoSize(PChar(aFileName), Wnd); + if (doInfoSize <> 0) then begin + GetMem(ptVersion, doInfoSize); + try + if GetFileVersionInfo(PChar(aFileName), Wnd, doInfoSize, ptVersion) then + if VerQueryValue(ptVersion, '\', Pointer(ptFixedFileInfo), doVersionSize) then begin + woMajorVersion := (ptFixedFileInfo^.dwFileVersionMS div $FFFF); + woMinorVersion := (ptFixedFileInfo^.dwFileVersionMS and $0000FFFF); + woSubVersion := (ptFixedFileInfo^.dwFileVersionLS div $FFFF); + woBuildNumber := (ptFixedFileInfo^.dwFileVersionLS and $0000FFFF); + s := Format('(v %d.%d.%d.%d)', [woMajorVersion, woMinorVersion, woSubVersion, woBuildNumber]); + Found := True; + end; + {endif} + finally + FreeMem(ptVersion); + end; + end else begin + s := ''; + Found := True; + end; + if s = '' then + s := '(v inconnue)'; + {endif} + result := s; +end; + +end. + \ No newline at end of file diff --git a/src/u_vibrate.pas b/src/u_vibrate.pas new file mode 100644 index 0000000..a464a5e --- /dev/null +++ b/src/u_vibrate.pas @@ -0,0 +1,79 @@ +unit u_vibrate; + +interface + +(* + Permet le déclenchement du vibreur du smartphone. + basé sur http://community.embarcadero.com/blogs/entry/how-to-vibrate-ios-and-android-phones-using-firemonkey-and-xe8 + + Pour Android : + - activer l'autorisation "vibrate" ou "vibrer" dans les autorisations de l'application + + Pour iOS : + - ajouter le framework "AudioToolbox" dans le SDK Manager avec comme chemin "$(SDKROOT)/System/Library/Frameworks" + + Pour les autres plateformes : + - ne rien faire puisqu'elles ne sont pas gérées. + + Liste des mises à jour : + 23/05/2016, Patrick Prémartin : version initiale +*) + +/// Use vibrator's smartphone or tablet (Android / iOS) +/// Number of milliseconds the device vibrate for Android. On iOs, there is no delay. +procedure vibrate(milliseconds: cardinal = 500); + +implementation + +{$IFDEF ANDROID} + +uses + Androidapi.JNI.Os, + Androidapi.JNI.GraphicsContentViewText, + Androidapi.Helpers, + Androidapi.JNIBridge; +{$ENDIF} +{$IFDEF IOS} + +uses + IOSapi.MediaPlayer, + IOSapi.CoreGraphics, + FMX.Platform, + FMX.Platform.IOS, + IOSapi.UIKit, + Macapi.ObjCRuntime, + Macapi.ObjectiveC, + IOSapi.Cocoatypes, + Macapi.CoreFoundation, + IOSapi.Foundation, + IOSapi.CoreImage, + IOSapi.QuartzCore, + IOSapi.CoreData; + +Const + libAudioToolbox = + '/System/Library/Frameworks/AudioToolbox.framework/AudioToolbox'; + kSystemSoundID_vibrate = $FFF; + +Procedure AudioServicesPlaySystemSound(inSystemSoundID: integer); Cdecl; + External libAudioToolbox Name _PU + 'AudioServicesPlaySystemSound'; +{$ENDIF} + +procedure vibrate(milliseconds: cardinal); +{$IFDEF ANDROID} +Var + Vibrator: JVibrator; +{$ENDIF} +begin +{$IFDEF ANDROID} + Vibrator := TJVibrator.Wrap + ((SharedActivityContext.getSystemService + (TJContext.JavaClass.VIBRATOR_SERVICE) as ILocalObject).GetObjectID); + Vibrator.vibrate(milliseconds); +{$ENDIF} +{$IFDEF IOS} + AudioServicesPlaySystemSound(kSystemSoundID_vibrate); +{$ENDIF} +end; + +end.