This post is just for announce which the VCL Styles Utils project now supports Delphi XE3.
Exploring Delphi XE3 – Record Helpers for simple types – System.SysUtils.TStringHelper
Delphi X3 introduces a very cool language extension, which is Record Helpers for simple types. So you can add a set of fields, properties or methods to strings, integers, Double, TDateTime and so on.
In this post I will show you the TStringHelper record helper for the string type defined in the System.SysUtils unit. Take a look to the definition of this record helper.
TStringHelper = record helper for string
private
function GetChars(Index: Integer): Char; inline;
function GetLength: Integer; inline;
class function CharInArray(const C: Char; const InArray: array of Char): Boolean; static;
function IndexOfAny(const Values: array of string; var Index: Integer): Integer; overload;
public
const Empty = '';
// Methods
class function Create(C: Char; Count: Integer): string; overload; inline; static;
class function Create(const Value: array of Char; StartIndex: Integer; Length: Integer): string; overload; static;
class function Create(const Value: array of Char): string; overload; static;
class function Compare(const StrA: string; const StrB: string): Integer; overload; static;
class function Compare(const StrA: string; const StrB: string; IgnoreCase: Boolean): Integer; overload; static;
class function Compare(const StrA: string; IndexA: Integer; const StrB: string; IndexB: Integer; Length: Integer): Integer; overload; static;
class function Compare(const StrA: string; IndexA: Integer; const StrB: string; IndexB: Integer; Length: Integer; IgnoreCase: Boolean): Integer; overload; static;
class function CompareOrdinal(const strA: string; const strB: string): Integer; overload; static;
class function CompareOrdinal(const strA: string; indexA: Integer; const strB: string; indexB: Integer; length: Integer): Integer; overload; static;
function CompareTo(const strB: string): Integer;
function Contains(const Value: string): Boolean;
class function Copy(const Str: string): string; inline; static;
procedure CopyTo(SourceIndex: Integer; var destination: array of Char; DestinationIndex: Integer; Count: Integer);
class function EndsText(const ASubText, AText: string): Boolean; static;
function EndsWith(const Value: string): Boolean; overload;
function EndsWith(const Value: string; IgnoreCase: Boolean): Boolean; overload;
function Equals(const Value: string): Boolean; overload;
class function Equals(const a: string; const b: string): Boolean; overload; static;
class function Format(const Format: string; const args: array of const): string; overload; static;
function GetHashCode: Integer;
function IndexOf(value: Char): Integer; overload; inline;
function IndexOf(const Value: string): Integer; overload; inline;
function IndexOf(Value: Char; StartIndex: Integer): Integer; overload;
function IndexOf(const Value: string; StartIndex: Integer): Integer; overload;
function IndexOf(Value: Char; StartIndex: Integer; Count: Integer): Integer; overload;
function IndexOf(const Value: string; StartIndex: Integer; Count: Integer): Integer; overload;
function IndexOfAny(const AnyOf: array of Char): Integer; overload;
function IndexOfAny(const AnyOf: array of Char; StartIndex: Integer): Integer; overload;
function IndexOfAny(const AnyOf: array of Char; StartIndex: Integer; Count: Integer): Integer; overload;
function Insert(StartIndex: Integer; const Value: string): string;
function IsDelimiter(const Delimiters: string; Index: Integer): Boolean;
function IsEmpty: Boolean;
class function IsNullOrEmpty(const Value: string): Boolean; static;
class function IsNullOrWhiteSpace(const Value: string): Boolean; static;
class function Join(const Separator: string; const values: array of const): string; overload; static;
class function Join(const Separator: string; const Values: array of string): string; overload; static;
class function Join(const Separator: string; const Values: IEnumerable): string; overload; static;
class function Join(const Separator: string; const value: array of string; StartIndex: Integer; Count: Integer): string; overload; static;
function LastDelimiter(const Delims: string): Integer;
function LastIndexOf(Value: Char): Integer; overload;
function LastIndexOf(const Value: string): Integer; overload;
function LastIndexOf(Value: Char; StartIndex: Integer): Integer; overload;
function LastIndexOf(const Value: string; StartIndex: Integer): Integer; overload;
function LastIndexOf(Value: Char; StartIndex: Integer; Count: Integer): Integer; overload;
function LastIndexOf(const Value: string; StartIndex: Integer; Count: Integer): Integer; overload;
function LastIndexOfAny(const AnyOf: array of Char): Integer; overload;
function LastIndexOfAny(const AnyOf: array of Char; StartIndex: Integer): Integer; overload;
function LastIndexOfAny(const AnyOf: array of Char; StartIndex: Integer; Count: Integer): Integer; overload;
function PadLeft(TotalWidth: Integer): string; overload; inline;
function PadLeft(TotalWidth: Integer; PaddingChar: Char): string; overload; inline;
function PadRight(TotalWidth: Integer): string; overload; inline;
function PadRight(TotalWidth: Integer; PaddingChar: Char): string; overload; inline;
function Remove(StartIndex: Integer): string; overload; inline;
function Remove(StartIndex: Integer; Count: Integer): string; overload; inline;
function Replace(OldChar: Char; NewChar: Char): string; overload;
function Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; overload;
function Replace(const OldValue: string; const NewValue: string): string; overload;
function Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; overload;
function Split(const Separator: array of Char): TArray; overload;
function Split(const Separator: array of Char; Count: Integer): TArray; overload;
function Split(const Separator: array of Char; Options: TStringSplitOptions): TArray; overload;
function Split(const Separator: array of string; Options: TStringSplitOptions): TArray; overload;
function Split(const Separator: array of Char; Count: Integer; Options: TStringSplitOptions): TArray; overload;
function Split(const Separator: array of string; Count: Integer; Options: TStringSplitOptions): TArray; overload;
function StartsWith(const Value: string): Boolean; overload;
function StartsWith(const Value: string; IgnoreCase: Boolean): Boolean; overload;
function Substring(StartIndex: Integer): string; overload;
function Substring(StartIndex: Integer; Length: Integer): string; overload;
function ToCharArray: TArray; overload;
function ToCharArray(StartIndex: Integer; Length: Integer): TArray; overload;
function ToLower: string;
function ToLowerInvariant: string;
function ToUpper: string;
function ToUpperInvariant: string;
function Trim: string; overload;
function Trim(const TrimChars: array of Char): string; overload;
function TrimEnd(const TrimChars: array of Char): string;
function TrimStart(const TrimChars: array of Char): string;
property Chars[Index: Integer]: Char read GetChars;
property Length: Integer read GetLength;
end;
Note : The same rules for the class and record helpers applies, so you can define multiple helpers with a single type. However, only zero or one helper applies in any specific location in source code and only the record helper defined in the nearest scope will apply. The record helper scope is determined in the normal Delphi fashion (for example, right to left in the unit’s uses clause).
As you can see most of the strings related methods now are part of the string type, so now you can write code like this.
{$APPTYPE CONSOLE}
uses
System.SysUtils;
var
s,s1 :string;
begin
try
// Length property
s:='Hello Delphi XE3';
Writeln(Format('the string Length is %d',[s.Length]));
Writeln('The length of this literal string is '.Length);
//function Contains
if s.Contains('Delphi') then
Writeln(Format('the string "%s" contains the string "%s"',[s,'Delphi']));
//function EndsWith
if s.EndsWith('XE3') then
Writeln(Format('the string "%s" ends with the string "%s"',[s,'XE3']));
//function ToLower
Writeln(Format('using ToLower %s',[s.ToLower]));
//function ToUpper
Writeln(Format('using ToUpper %s',[s.ToUpper]));
//function IndexOf
Writeln(Format('The index of H is %d',[s.IndexOf('H')])); //the value is based in a zero index
//function LastDelimiter
Writeln(Format('The first occurence of any of these chars "abcdef" is %d',[s.IndexOfAny(['a','b','c','d','e','f'])])); //the value is based in a zero index
//function LastDelimiter
Writeln(Format('The last occurence of any of these chars "abcdef" is %d',[s.LastDelimiter('abcdef')])); //the value is based in a zero index
//function Remove
Writeln(Format('The string with only the first 5 chars is %s',[s.Remove(5)])); //the value is based in a zero index
//function Replace
Writeln(Format('Replacing the white spaces for "-", the string becomes %s',[s.Replace(' ','-')])); //the value is based in a zero index
//function split
Writeln;
Writeln('Testing the split function');
for s1 in s.Split([' ']) do
Writeln(s1);
Writeln;
//function Substring
Writeln(Format('The sub string starting in the index 6 is "%s"',[s.Substring(6)])); //the value is based in a zero index
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.
Note : All the methods and properties of the System.SysUtils.TStringHelper are zero based index, so be careful when you uses functions like CopyTo, IndexOf, IndexOfAny, Insert, Join, LastDelimiter, LastIndexOf, LastIndexOfAny, Remove, Substring, ToCharArray and the Chars property.
Finally exist a few set of record helpers included in the RTL code which you can use
- System.Classes – TUInt32Helper = record helper for UInt32
- System.SyncObjs – TCriticalSectionHelper = record helper for TRTLCriticalSection
- System.SyncObjs – TConditionVariableHelper = record helper for TRTLConditionVariable
- System.Mac.CFUtils – CFGregorianDateHelper = record helper for CFGregorianDate
- System.SysUtils – TGuidHelper = record helper for TGUID
- System – TSingleHelper = record helper for Single
- System – TDoubleHelper = record helper for Double
- System – TExtendedHelper = record helper for Extended
- Winapi.D2D1 – D2DMatrix3x2FHelper = record helper for TD2DMatrix3X2F
- Vcl.Themes – TElementMarginsHelper = record helper for TElementMargins
Disabling the Embedded Designer in RAD Studio XE3
In RAD Studio XE3 the option (located in Tools > Options > Environment Options > VCL Designer > Embedded Designer ) to disable the Embedded Designer was hide. Personally I still using the old floating designer when I work in VCL projects.
So if you want disable the Embedded Designer just go to the the windows registry key HKEY_CURRENT_USER\Software\Embarcadero\BDS\10.0\Form Design and set the Embedded Designer value to False
Note : Remember which FireMonkey only supports the embedded form designer.
Added support for RAD Studio XE3 in the Delphi IDE Theme Editor.
This post is just for announce which the Delphi IDE Theme Editor now supports RAD Studio XE3.
You can download the latest version from here
Using custom colors in the TDBGrid columns with vcl styles enabled
The TDBGrid component allows you to customize the colors of the columns and fonts used to draw the data.
Unfortunately if you uses the vcl styles all these customizations are lost
This issue is caused because the TCustomDBGrid.DrawCell method ignores the custom colors of the columns when the vcl styles are enabled. So the solution is patch this method to allow use the proper colors. After of this you will get a result like so.
I just uploaded this patch as part of the vcl styles utils project. To use it you must add the Vcl.Styles.DbGrid unit to the uses part of your form after of the Vcl.DBGrids unit.
Added new unit to the vcl style utils to fix the QC #103708, #107764 reports
I just uploaded a new unit to the vcl style utils project called Vcl.Styles.Fixes, this unit contains the TButtonStyleHook style hook which fix these QC #103708, #107764 reports for Delphi XE2.
Note : The QC #103708 still exist in Delphi XE2 Update 4, even if appears as resolved (XE3 maybe?)
Using the Bing search API (Windows Azure Marketplace version) from Delphi
Introduction
Some time ago I wrote a entry about how use the Bing search API from Delphi , now this API was migrated to the Windows Azure Marketplace so it’s time to upgrade the source code to access this API.
The Bing Search API allow you to get search results retrieving the results in XML or JSON format. This API offers multiple source types (or types of search results) with each query. For example you can request web, images, news, and video results for a single search query.
In order to use the Bing Search API you must obtain an account key in the Windows Azure Marketplace, Then this key must be used in a Basic Authentication scheme to authenticate the requests.
Building the URL
The next step is build a valid URL to make the GET request. This is the basic structure of a Bing Search URL.
https://api.datamarket.azure.com/Bing/Search/%5Bsourcetype%5D?Query=%5BSearchTerm%5D&$format=%5BResponse format]&$top=5&$skip=0
This sample URL which uses the Web source type.
https://api.datamarket.azure.com/Bing/Search/Web?Query=%27Delphi%27&$format=ATOM&$top=5&$skip=0
These are the URI Input parameters for the Web source type.
| Name | Sample values | Type | Required |
|---|---|---|---|
| Query | Hello | String | X |
| Adult | Moderate | String | |
| Latitude | 48.59 | Double | |
| Longitude | -112.31 | Double | |
| Market | en-US | String | |
| Options | EnableHighlighting | String | |
| WebFileType | XLS | String | |
| WebSearchOptions | DisableQueryAlterations | String |
These are the fields returned in the response.
| Name | Type |
|---|---|
| ID | Guid |
| Title | String |
| Description | String |
| DisplayUrl | String |
| Url | String |
Indy Sample
Check this sample Delphi code which uses Indy to make the GET request.
{$APPTYPE CONSOLE}
{$R *.res}
uses
MSXML,
ActiveX,
ComObj,
Variants,
IdURI,
IdHttp,
IdSSLOpenSSL,
SysUtils;
procedure GetBingInfoXML_Web(const SearchKey : string;Top, Skip : Integer);
const
ApplicationID= 'put your key here';
URI='https://api.datamarket.azure.com/Bing/Search/Web?Query=%s&$format=ATOM&$top=%d&$skip=%d';
var
XMLDOMDocument : IXMLDOMDocument;
XMLDOMNode : IXMLDOMNode;
cXMLDOMNode : IXMLDOMNode;
XMLDOMNodeList : IXMLDOMNodeList;
LIdHTTP : TIdHTTP;
LIOHandler : TIdSSLIOHandlerSocketOpenSSL;
LIndex : Integer;
Response: string;
begin
LIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
LIOHandler.SSLOptions.Method := sslvTLSv1;
LIOHandler.SSLOptions.Mode := sslmUnassigned;
LIOHandler.SSLOptions.VerifyMode := [];
LIOHandler.SSLOptions.VerifyDepth := 0;
LIOHandler.host := '';
LIdHTTP:= TIdHTTP.Create(nil);
try
LIdHTTP.Request.ContentEncoding := 'utf-8';
LIdHTTP.Request.BasicAuthentication:= True;
LIdHTTP.Request.Username:=ApplicationID;
LIdHTTP.Request.Password:=ApplicationID;
LIdHTTP.IOHandler:= LIOHandler;
Response:=LIdHTTP.Get(Format(URI,[TIdURI.PathEncode(QuotedStr(SearchKey)), Top, Skip]));
XMLDOMDocument:=CoDOMDocument.Create;
try
XMLDOMDocument.loadXML(Response);
XMLDOMNode := XMLDOMDocument.selectSingleNode('/feed');
XMLDOMNodeList := XMLDOMNode.selectNodes('//entry');
if XMLDOMNodeList<>nil then
for LIndex:=0 to XMLDOMNodeList.length-1 do
begin
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:ID',[LIndex]));
Writeln(Format('id %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Title',[LIndex]));
Writeln(Format('Title %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Description',[LIndex]));
Writeln(Format('Description %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:DisplayUrl',[LIndex]));
Writeln(Format('DisplayUrl %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Url',[LIndex]));
Writeln(Format('Url %s',[String(cXMLDOMNode.Text)]));
Writeln;
end;
finally
XMLDOMDocument:=nil;
end;
finally
LIdHTTP.Free;
end;
finally
LIOHandler.Free;
end;
end;
begin
try
CoInitialize(nil);
try
GetBingInfoXML_Web('delphi programming blogs', 5, 0);
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
IXMLHTTPRequest Sample
Check this sample Delphi code which uses the IXMLHTTPRequest interface to make the GET request.
{$APPTYPE CONSOLE}
{$R *.res}
uses
MSXML,
ActiveX,
ComObj,
Variants,
IdURI,
SysUtils;
procedure GetBingInfoXML_Web(const SearchKey : string;Top, Skip : Integer);
const
ApplicationID= 'put your key here';
URI='https://api.datamarket.azure.com/Bing/Search/Web?Query=%s&$format=ATOM&$top=%d&$skip=%d';
COMPLETED=4;
OK =200;
var
XMLHTTPRequest : IXMLHTTPRequest;
XMLDOMDocument : IXMLDOMDocument;
XMLDOMNode : IXMLDOMNode;
cXMLDOMNode : IXMLDOMNode;
XMLDOMNodeList : IXMLDOMNodeList;
LIndex : Integer;
begin
XMLHTTPRequest := CreateOleObject('MSXML2.XMLHTTP') As IXMLHTTPRequest;
XMLHTTPRequest.open('GET',Format(URI,[TIdURI.PathEncode(QuotedStr(SearchKey)), Top, Skip]), False, ApplicationID, ApplicationID);
XMLHTTPRequest.send('');
if (XMLHTTPRequest.readyState = COMPLETED) and (XMLHTTPRequest.status = OK) then
begin
XMLDOMDocument:=CoDOMDocument.Create;
try
XMLDOMDocument.loadXML(XMLHTTPRequest.responseText);
XMLDOMNode := XMLDOMDocument.selectSingleNode('/feed');
XMLDOMNodeList := XMLDOMNode.selectNodes('//entry');
if XMLDOMNodeList<>nil then
for LIndex:=0 to XMLDOMNodeList.length-1 do
begin
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:ID',[LIndex]));
Writeln(Format('id %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Title',[LIndex]));
Writeln(Format('Title %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Description',[LIndex]));
Writeln(Format('Description %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:DisplayUrl',[LIndex]));
Writeln(Format('DisplayUrl %s',[String(cXMLDOMNode.Text)]));
cXMLDOMNode:=XMLDOMNode.selectSingleNode(Format('//entry[%d]/content/m:properties/d:Url',[LIndex]));
Writeln(Format('Url %s',[String(cXMLDOMNode.Text)]));
Writeln;
end;
finally
XMLDOMDocument:=nil;
end;
end;
end;
begin
try
CoInitialize(nil);
try
GetBingInfoXML_Web('delphi programming blogs', 5, 0);
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Recommended Resources
A quick guide to evaluate and compile expressions using the LiveBindings expression evaluator.
The LiveBindings technology introduced in Delphi XE2, includes a set of interfaces, classes and methods to evaluate and compile expressions.
Today I will show you how you can use these classes to build, compile and evaluate simple (and complex) expressions. You can use these expressions for example to define formulas to calculate taxes, generate hashes, encrypt data or use in any situation where you need calculate a value where the values or factors may change (anyway the possibilities are endless), Also you can store these expressions in a XML file or a database and use them as needed.
Note: In this article is not used the TBindingExpression class directly, instead are used the raw classes and methods of the of livebindings expression evaluator, because you can gain much more flexibility to build your expressions.
Before to begin is necessary know the basic elements to build, compile and evaluate an expression.
- The IScope is the base Interface to hold the objects used to make the evaluation and compilation, here you store the methods , classes and values which will be used to build the expression.
- The Compile method located in the System.Bindings.Evaluator unit, is used to compile the expression using a IScope interface, this method will return a ICompiledBinding interface which can be used to evaluate and get the result of the compilation.
- The ICompiledBinding interface allows the evaluation of the compiled expression.
- The TNestedScope class allows you to merge IScopes.
Basic Example
The more basic expression which you can use is based in the BasicOperators Scope (located in the System.Bindings.EvalSys unit), this allows you evaluate only numbers and the basic arithmetic operations, check this sample.
{$APPTYPE CONSOLE}
uses
System.Rtti,
System.Bindings.EvalProtocol,
System.Bindings.Evaluator,
System.Bindings.EvalSys,
System.SysUtils;
procedure DoIt;
Var
LScope : IScope;
LCompiledExpr : ICompiledBinding;
LResult : TValue;
begin
LScope:= BasicOperators;
LCompiledExpr:= Compile('((1+2+3+4)*(25/5))-(10)', LScope);
LResult:=LCompiledExpr.Evaluate(LScope, nil, nil).GetValue;
if not LResult.IsEmpty then
Writeln(LResult.ToString);
end;
begin
try
DoIt;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Registering a Constant
Now if you need evaluate the value of a constant you must create a IScope descendent and add the constants to register, finally you must merge the new scope with the original using the TNestedScope.
{$APPTYPE CONSOLE}
uses
System.Rtti,
System.Bindings.EvalProtocol,
System.Bindings.Evaluator,
System.Bindings.EvalSys,
System.SysUtils;
procedure DoIt;
Var
LScope : IScope;
LCompiledExpr : ICompiledBinding;
LResult : TValue;
LDictionaryScope: TDictionaryScope;
begin
LScope:= TNestedScope.Create(BasicOperators, BasicConstants);
LDictionaryScope := TDictionaryScope.Create;
//add a set of constants to the Scope
LDictionaryScope.Map.Add('MinsPerHour', TValueWrapper.Create(MinsPerHour));
LDictionaryScope.Map.Add('MinsPerDay', TValueWrapper.Create(MinsPerDay));
LDictionaryScope.Map.Add('MSecsPerSec', TValueWrapper.Create(MSecsPerSec));
LDictionaryScope.Map.Add('MSecsPerDay', TValueWrapper.Create(MSecsPerDay));
//merge the scopes
LScope:= TNestedScope.Create(LScope, LDictionaryScope);
LCompiledExpr:= Compile('MinsPerHour*24', LScope);
LResult:=LCompiledExpr.Evaluate(LScope, nil, nil).GetValue;
if not LResult.IsEmpty then
Writeln(LResult.ToString);
end;
begin
try
DoIt;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
In the above code the Scope is initialized using the TNestedScope class to merge the BasicOperators and BasicConstants (this Scope define the values True, False, nil, and Pi) scopes
LScope:= TNestedScope.Create(BasicOperators, BasicConstants);
Tip 1 : The constants and identifiers in the expression are case-sensitive.
Using Methods
The livebindings expression evaluator include a set of basic methods (ToStr, ToVariant, ToNotifyEvent, Round, Format, UpperCase, LowerCase, FormatDateTime, StrToDateTime, Math_Min, Math_Max) which can be used in our expressions, these are defined in the System.Bindings.Methods unit and must be accessed the TBindingMethodsFactory class.
Check this sample code which uses the Format function.
{$APPTYPE CONSOLE}
uses
System.Rtti,
System.Bindings.EvalProtocol,
System.Bindings.Evaluator,
System.Bindings.EvalSys,
System.Bindings.Methods,
System.SysUtils;
procedure DoIt;
Var
LScope : IScope;
LCompiledExpr : ICompiledBinding;
LResult : TValue;
LDictionaryScope: TDictionaryScope;
begin
LScope:= TNestedScope.Create(BasicOperators, BasicConstants);
//add the registered methods
LScope := TNestedScope.Create(LScope, TBindingMethodsFactory.GetMethodScope);
LCompiledExpr:= Compile('Format("%s using the function %s, this function can take numbers like %d or %n as well","This is a formated string","Format",36, Pi)', LScope);
LResult:=LCompiledExpr.Evaluate(LScope, nil, nil).GetValue;
if not LResult.IsEmpty then
Writeln(LResult.ToString);
end;
begin
try
DoIt;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Tip 2 : The strings in the expressions can be surrounded in double or single quotes.
Registering a Custom Method
Most of the times when you build an expression, you will need register a custom method, this can be easily done using the TBindingMethodsFactory class.
The first step is create a function wich returns a IInvokable interface. For this you can use the MakeInvokable method and then you write the implementation of your function as an anonymous method.
Finally using the TBindingMethodsFactory.RegisterMethod function you can register the custom method.
Check this sample code which implement a custom function called IfThen :)
{$APPTYPE CONSOLE}
uses
System.Rtti,
System.TypInfo,
System.Bindings.Consts,
System.Bindings.EvalProtocol,
System.Bindings.Evaluator,
System.Bindings.EvalSys,
System.Bindings.Methods,
System.SysUtils;
{
function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
function IfThen(AValue: Boolean; const ATrue: Int64; const AFalse: Int64): Int64;
function IfThen(AValue: Boolean; const ATrue: UInt64; const AFalse: UInt64): UInt64;
function IfThen(AValue: Boolean; const ATrue: Single; const AFalse: Single): Single;
function IfThen(AValue: Boolean; const ATrue: Double; const AFalse: Double): Double;
function IfThen(AValue: Boolean; const ATrue: Extended; const AFalse: Extended): Extended;
}
function IfThen: IInvokable;
begin
Result := MakeInvokable(
function(Args: TArray<IValue>): IValue
var
IAValue: IValue;
AValue: Boolean;
IATrue, IAFalse: IValue;
begin
//check the number of passed parameters
if Length(Args) <> 3 then
raise EEvaluatorError.Create(sFormatArgError);
IAValue:=Args[0];
IATrue :=Args[1];
IAFalse:=Args[2];
//check if the parameters has values
if IATrue.GetValue.IsEmpty or IAFalse.GetValue.IsEmpty then
Exit(TValueWrapper.Create(nil))
else
//check if the parameters has the same types
if IATrue.GetValue.Kind<>IAFalse.GetValue.Kind then
raise EEvaluatorError.Create('The return values must be of the same type')
else
//check if the first parameter is boolean
if (IAValue.GetType.Kind=tkEnumeration) and (IAValue.GetValue.TryAsType<Boolean>(AValue)) then //Boolean is returned as tkEnumeration
begin
if AValue then
//return the value for True condition
Exit(TValueWrapper.Create(IATrue.GetValue))
else
//return the value for the False condition
Exit(TValueWrapper.Create(IAFalse.GetValue))
end
else raise EEvaluatorError.Create('The first parameter must be a boolean expression');
end
);
end;
procedure DoIt;
Var
LScope : IScope;
LCompiledExpr : ICompiledBinding;
LResult : TValue;
LDictionaryScope: TDictionaryScope;
begin
LScope:= TNestedScope.Create(BasicOperators, BasicConstants);
//add a custom method
TBindingMethodsFactory.RegisterMethod(
TMethodDescription.Create(
IfThen,
'IfThen',
'IfThen',
'',
True,
'',
nil));
//add the registered methods
LScope := TNestedScope.Create(LScope, TBindingMethodsFactory.GetMethodScope);
LCompiledExpr:= Compile('Format("The sentence is %s", IfThen(1>0,"True","False"))', LScope);
LResult:=LCompiledExpr.Evaluate(LScope, nil, nil).GetValue;
if not LResult.IsEmpty then
Writeln(LResult.ToString);
end;
begin
try
DoIt;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Tip 3 : Remember use TBindingMethodsFactory.UnRegisterMethod function to unregister your custom method.
Registering a Class
In order to use your own class in an expression you must create a Scope using the TObjectWrapper class or the WrapObject method.
{$APPTYPE CONSOLE}
uses
System.Rtti,
System.TypInfo,
System.Bindings.Consts,
System.Bindings.EvalProtocol,
System.Bindings.Evaluator,
System.Bindings.EvalSys,
System.Bindings.ObjEval,
System.SysUtils;
Type
TMyClass= class
function Random(Value:Integer): Integer;
end;
{ TMyClass }
function TMyClass.Random(Value:Integer): Integer;
begin
Result:=System.Random(Value);
end;
procedure DoIt;
Var
LScope : IScope;
LCompiledExpr : ICompiledBinding;
LResult : TValue;
LDictionaryScope: TDictionaryScope;
M : TMyClass;
begin
M := TMyClass.Create;
try
LScope:= TNestedScope.Create(BasicOperators, BasicConstants);
//add a object
LDictionaryScope := TDictionaryScope.Create;
LDictionaryScope.Map.Add('M', WrapObject(M));
LScope := TNestedScope.Create(LScope, LDictionaryScope);
LCompiledExpr:= Compile('M.Random(10000000)', LScope);
LResult:=LCompiledExpr.Evaluate(LScope, nil, nil).GetValue;
if not LResult.IsEmpty then
Writeln(LResult.ToString);
finally
M.Free;
end;
end;
begin
try
Randomize;
DoIt;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Support the WMI Delphi Code Creator in the Open Source Advertising – Sidebar – 2012
Support the WMI Delphi Code Creator in the Open Source Advertising – Sidebar – 2012
Getting the environment variables of an external x86 and x64 process
On my last post was show how get the environment variables of an external x86 process, now it’s time to show how access the same information for x64 (and x86) process from a 64 bits application.
In order to access the environment variables of a x64 process, you must use a 64 bits application, So if you compile the code posted in the last article in a 64 bits app, the code will still working but only for read the environment variables of x64 processes, this is because the offset of the fields of the records changes due to the Pointer and THandle types now have a 8 bytes size, and the structures which hold the data in a 32 bits process still using 4 bytes to represent the adresses (Pointers) and Handles (THandle). So the first step is create 2 new types to replace the Pointer and THandle types like so.
Pointer32 = ULONG; THANDLE32 = ULONG;
Now using these new types we can create a 32 bits version of the records to access the PEB.
type
Pointer32 = ULONG;
THANDLE32 = ULONG;
_UNICODE_STRING32 = record
Length: Word;
MaximumLength: Word;
Buffer: Pointer32;
end;
UNICODE_STRING32 = _UNICODE_STRING32;
_RTL_DRIVE_LETTER_CURDIR32 = record
Flags: Word;
Length: Word;
TimeStamp: ULONG;
DosPath: UNICODE_STRING32;
end;
RTL_DRIVE_LETTER_CURDIR32 = _RTL_DRIVE_LETTER_CURDIR32;
_CURDIR32 = record
DosPath: UNICODE_STRING32;
Handle: THANDLE32;
end;
CURDIR32 = _CURDIR32;
_RTL_USER_PROCESS_PARAMETERS32 = record
MaximumLength: ULONG;
Length: ULONG;
Flags: ULONG;
DebugFlags: ULONG;
ConsoleHandle: THANDLE32;
ConsoleFlags: ULONG;
StandardInput: THANDLE32;
StandardOutput: THANDLE32;
StandardError: THANDLE32;
CurrentDirectory: CURDIR32;
DllPath: UNICODE_STRING32;
ImagePathName: UNICODE_STRING32;
CommandLine: UNICODE_STRING32;
Environment: Pointer32;
StartingX: ULONG;
StartingY: ULONG;
CountX: ULONG;
CountY: ULONG;
CountCharsX: ULONG;
CountCharsY: ULONG;
FillAttribute: ULONG;
WindowFlags: ULONG;
ShowWindowFlags: ULONG;
WindowTitle: UNICODE_STRING32;
DesktopInfo: UNICODE_STRING32;
ShellInfo: UNICODE_STRING32;
RuntimeData: UNICODE_STRING32;
CurrentDirectories: array[0..31] of RTL_DRIVE_LETTER_CURDIR32;
end;
RTL_USER_PROCESS_PARAMETERS32 = _RTL_USER_PROCESS_PARAMETERS32;
PRTL_USER_PROCESS_PARAMETERS32 = ^RTL_USER_PROCESS_PARAMETERS32;
_PEB32 = record
Reserved1 : array [0..1] of Byte;
BeingDebugged : Byte;
Reserved2 : Byte;
Reserved3 : array [0..1] of Pointer32;
Ldr : Pointer32;
ProcessParameters : Pointer32;//PRTL_USER_PROCESS_PARAMETERS;
Reserved4 : array [0..102] of Byte;
Reserved5 : array [0..51] of Pointer32;
PostProcessInitRoutine : Pointer32;
Reserved6 : array [0..127] of byte;
Reserved7 : Pointer32;
SessionId : ULONG;
end;
PEB32=_PEB32;
Reading the PEB Address of a X86 process from a 64 bits app
Additional to the above changes we must modify the code to get the PEB address of a 32 bits process, this can be done using the NtQueryInformationProcess function passing ProcessWow64Information value, this will return the PEB Adresss of a process running under WOW64.
NtQueryInformationProcess(ProcessHandle, ProcessWow64Information, @PEBBaseAddress32, SizeOf(PEBBaseAddress32), nil)
And now using the ReadProcessMemory function and the new defined types we can read the environment variables block.
//read the PEB structure
if not ReadProcessMemory(ProcessHandle, PEBBaseAddress32, @Peb32, sizeof(Peb32), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//read the RTL_USER_PROCESS_PARAMETERS structure
if not ReadProcessMemory(ProcessHandle, Pointer(Peb32.ProcessParameters), @Rtl32, SizeOf(Rtl32), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//get the size of the Env. variables block
if VirtualQueryEx(ProcessHandle, Pointer(Rtl32.Environment), Mbi, SizeOf(Mbi))=0 then
RaiseLastOSError
else
EnvStrLength :=(mbi.RegionSize -(ULONG_PTR(Pointer(Rtl32.Environment)) - ULONG_PTR(mbi.BaseAddress)));
SetLength(EnvStrBlock, EnvStrLength);
//read the content of the env. variables block
if not ReadProcessMemory(ProcessHandle, Pointer(Rtl32.Environment), @EnvStrBlock[0], EnvStrLength, lpNumberOfBytesRead) then
RaiseLastOSError
else
Result:=TEncoding.Unicode.GetString(EnvStrBlock);
end;
end;
The source code
Finally this is the full source code.
program NtQueryInformationProcess_EnvVarsX64;
//Author Rodrigo Ruz (RRUZ)
//2012-06-09
{$APPTYPE CONSOLE}
{$IFNDEF UNICODE} this code only runs under unicode delphi versions{$ENDIF}
{$R *.res}
uses
Classes,
SysUtils,
Windows;
type
Pointer32 = ULONG;
THANDLE32 = ULONG;
_UNICODE_STRING = record
Length: Word;
MaximumLength: Word;
Buffer: LPWSTR;
end;
UNICODE_STRING = _UNICODE_STRING;
//http://msdn.microsoft.com/en-us/library/windows/desktop/ms684280%28v=vs.85%29.aspx
PROCESS_BASIC_INFORMATION = record
Reserved1 : Pointer;
PebBaseAddress: Pointer;
Reserved2: array [0..1] of Pointer;
UniqueProcessId: ULONG_PTR;
Reserved3: Pointer;
end;
//http://undocumented.ntinternals.net/UserMode/Structures/RTL_DRIVE_LETTER_CURDIR.html
_RTL_DRIVE_LETTER_CURDIR = record
Flags: Word;
Length: Word;
TimeStamp: ULONG;
DosPath: UNICODE_STRING;
end;
RTL_DRIVE_LETTER_CURDIR = _RTL_DRIVE_LETTER_CURDIR;
_CURDIR = record
DosPath: UNICODE_STRING;
Handle: THANDLE;
end;
CURDIR = _CURDIR;
//http://undocumented.ntinternals.net/UserMode/Structures/RTL_USER_PROCESS_PARAMETERS.html
_RTL_USER_PROCESS_PARAMETERS = record
MaximumLength: ULONG;
Length: ULONG;
Flags: ULONG;
DebugFlags: ULONG;
ConsoleHandle: THANDLE;
ConsoleFlags: ULONG;
StandardInput: THANDLE;
StandardOutput: THANDLE;
StandardError: THANDLE;
CurrentDirectory: CURDIR;
DllPath: UNICODE_STRING;
ImagePathName: UNICODE_STRING;
CommandLine: UNICODE_STRING;
Environment: Pointer;
StartingX: ULONG;
StartingY: ULONG;
CountX: ULONG;
CountY: ULONG;
CountCharsX: ULONG;
CountCharsY: ULONG;
FillAttribute: ULONG;
WindowFlags: ULONG;
ShowWindowFlags: ULONG;
WindowTitle: UNICODE_STRING;
DesktopInfo: UNICODE_STRING;
ShellInfo: UNICODE_STRING;
RuntimeData: UNICODE_STRING;
CurrentDirectories: array[0..31] of RTL_DRIVE_LETTER_CURDIR;
end;
RTL_USER_PROCESS_PARAMETERS = _RTL_USER_PROCESS_PARAMETERS;
PRTL_USER_PROCESS_PARAMETERS = ^RTL_USER_PROCESS_PARAMETERS;
_PEB = record
Reserved1 : array [0..1] of Byte;
BeingDebugged : Byte;
Reserved2 : Byte;
Reserved3 : array [0..1] of Pointer;
Ldr : Pointer;
ProcessParameters : PRTL_USER_PROCESS_PARAMETERS;
Reserved4 : array [0..102] of Byte;
Reserved5 : array [0..51] of Pointer;
PostProcessInitRoutine : Pointer;
Reserved6 : array [0..127] of byte;
Reserved7 : Pointer;
SessionId : ULONG;
end;
PEB=_PEB;
{$IFDEF CPUX64}
_UNICODE_STRING32 = record
Length: Word;
MaximumLength: Word;
Buffer: Pointer32;
end;
UNICODE_STRING32 = _UNICODE_STRING32;
_RTL_DRIVE_LETTER_CURDIR32 = record
Flags: Word;
Length: Word;
TimeStamp: ULONG;
DosPath: UNICODE_STRING32;
end;
RTL_DRIVE_LETTER_CURDIR32 = _RTL_DRIVE_LETTER_CURDIR32;
_CURDIR32 = record
DosPath: UNICODE_STRING32;
Handle: THANDLE32;
end;
CURDIR32 = _CURDIR32;
_RTL_USER_PROCESS_PARAMETERS32 = record
MaximumLength: ULONG;
Length: ULONG;
Flags: ULONG;
DebugFlags: ULONG;
ConsoleHandle: THANDLE32;
ConsoleFlags: ULONG;
StandardInput: THANDLE32;
StandardOutput: THANDLE32;
StandardError: THANDLE32;
CurrentDirectory: CURDIR32;
DllPath: UNICODE_STRING32;
ImagePathName: UNICODE_STRING32;
CommandLine: UNICODE_STRING32;
Environment: Pointer32;
StartingX: ULONG;
StartingY: ULONG;
CountX: ULONG;
CountY: ULONG;
CountCharsX: ULONG;
CountCharsY: ULONG;
FillAttribute: ULONG;
WindowFlags: ULONG;
ShowWindowFlags: ULONG;
WindowTitle: UNICODE_STRING32;
DesktopInfo: UNICODE_STRING32;
ShellInfo: UNICODE_STRING32;
RuntimeData: UNICODE_STRING32;
CurrentDirectories: array[0..31] of RTL_DRIVE_LETTER_CURDIR32;
end;
RTL_USER_PROCESS_PARAMETERS32 = _RTL_USER_PROCESS_PARAMETERS32;
PRTL_USER_PROCESS_PARAMETERS32 = ^RTL_USER_PROCESS_PARAMETERS32;
_PEB32 = record
Reserved1 : array [0..1] of Byte;
BeingDebugged : Byte;
Reserved2 : Byte;
Reserved3 : array [0..1] of Pointer32;
Ldr : Pointer32;
ProcessParameters : Pointer32;//PRTL_USER_PROCESS_PARAMETERS;
Reserved4 : array [0..102] of Byte;
Reserved5 : array [0..51] of Pointer32;
PostProcessInitRoutine : Pointer32;
Reserved6 : array [0..127] of byte;
Reserved7 : Pointer32;
SessionId : ULONG;
end;
PEB32=_PEB32;
{$ENDIF}
function NtQueryInformationProcess(ProcessHandle : THandle; ProcessInformationClass : DWORD; ProcessInformation : Pointer; ProcessInformationLength : ULONG; ReturnLength : PULONG ): LongInt; stdcall; external 'ntdll.dll';
function NtQueryVirtualMemory(ProcessHandle : THandle; BaseAddress : Pointer; MemoryInformationClass : DWORD; MemoryInformation : Pointer; MemoryInformationLength : ULONG; ReturnLength : PULONG ): LongInt; stdcall; external 'ntdll.dll';
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
_IsWow64Process : TIsWow64Process;
procedure Init_IsWow64Process;
var
hKernel32 : Integer;
begin
hKernel32 := LoadLibrary(kernel32);
if (hKernel32 = 0) then RaiseLastOSError;
try
_IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
finally
FreeLibrary(hKernel32);
end;
end;
function ProcessIsX64(hProcess: DWORD): Boolean;
var
IsWow64 : BOOL;
begin
Result := False;
{$IFNDEF CPUX64}
exit;
{$ENDIF}
if not Assigned(_IsWow64Process) then
Init_IsWow64Process;
if Assigned(_IsWow64Process) then
begin
if (_IsWow64Process(hProcess, IsWow64)) then
Result := not IsWow64
else
RaiseLastOSError;
end;
end;
function GetEnvVarsPid(dwProcessId : DWORD): string;
const
STATUS_SUCCESS = $00000000;
SE_DEBUG_NAME = 'SeDebugPrivilege';
ProcessWow64Information = 26;
var
ProcessHandle : THandle;
ProcessBasicInfo : PROCESS_BASIC_INFORMATION;
ReturnLength : DWORD;
lpNumberOfBytesRead : ULONG_PTR;
TokenHandle : THandle;
lpLuid : TOKEN_PRIVILEGES;
OldlpLuid : TOKEN_PRIVILEGES;
Rtl : RTL_USER_PROCESS_PARAMETERS;
Mbi : TMemoryBasicInformation;
Peb : _PEB;
EnvStrBlock : TBytes;
EnvStrLength : ULONG;
IsProcessx64 : Boolean;
{$IFDEF CPUX64}
PEBBaseAddress32 : Pointer;
Peb32 : _PEB32;
Rtl32 : RTL_USER_PROCESS_PARAMETERS32;
{$ENDIF}
begin
Result:='';
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
begin
try
if not LookupPrivilegeValue(nil, SE_DEBUG_NAME, lpLuid.Privileges[0].Luid) then
RaiseLastOSError
else
begin
lpLuid.PrivilegeCount := 1;
lpLuid.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
ReturnLength := 0;
OldlpLuid := lpLuid;
//Set the SeDebugPrivilege privilege
if not AdjustTokenPrivileges(TokenHandle, False, lpLuid, SizeOf(OldlpLuid), OldlpLuid, ReturnLength) then RaiseLastOSError;
end;
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, dwProcessId);
if ProcessHandle=0 then RaiseLastOSError
else
try
IsProcessx64 :=ProcessIsX64(ProcessHandle);
{$IFNDEF CPUX64}
if IsProcessx64 then
raise Exception.Create('Only 32 bits processes are supported');
{$ENDIF}
{$IFDEF CPUX64}
if IsProcessx64 then
begin
{$ENDIF}
// get the PROCESS_BASIC_INFORMATION to access to the PEB Address
if (NtQueryInformationProcess(ProcessHandle,0{=>ProcessBasicInformation},@ProcessBasicInfo, SizeOf(ProcessBasicInfo), @ReturnLength)=STATUS_SUCCESS) and (ReturnLength=SizeOf(ProcessBasicInfo)) then
begin
//read the PEB struture
if not ReadProcessMemory(ProcessHandle, ProcessBasicInfo.PEBBaseAddress, @Peb, sizeof(Peb), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//read the RTL_USER_PROCESS_PARAMETERS structure
if not ReadProcessMemory(ProcessHandle, Peb.ProcessParameters, @Rtl, SizeOf(Rtl), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//get the size of the Env. variables block
if VirtualQueryEx(ProcessHandle, Rtl.Environment, Mbi, SizeOf(Mbi))=0 then
RaiseLastOSError
else
EnvStrLength :=(mbi.RegionSize -(ULONG_PTR(Rtl.Environment) - ULONG_PTR(mbi.BaseAddress)));
SetLength(EnvStrBlock, EnvStrLength);
//read the content of the env. variables block
if not ReadProcessMemory(ProcessHandle, Rtl.Environment, @EnvStrBlock[0], EnvStrLength, lpNumberOfBytesRead) then
RaiseLastOSError
else
Result:=TEncoding.Unicode.GetString(EnvStrBlock);
end;
end;
end
else
RaiseLastOSError;
{$IFDEF CPUX64}
end
else
begin
//get the PEB address
if NtQueryInformationProcess(ProcessHandle, ProcessWow64Information, @PEBBaseAddress32, SizeOf(PEBBaseAddress32), nil)=STATUS_SUCCESS then
begin
//read the PEB structure
if not ReadProcessMemory(ProcessHandle, PEBBaseAddress32, @Peb32, sizeof(Peb32), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//read the RTL_USER_PROCESS_PARAMETERS structure
if not ReadProcessMemory(ProcessHandle, Pointer(Peb32.ProcessParameters), @Rtl32, SizeOf(Rtl32), lpNumberOfBytesRead) then
RaiseLastOSError
else
begin
//get the size of the Env. variables block
if VirtualQueryEx(ProcessHandle, Pointer(Rtl32.Environment), Mbi, SizeOf(Mbi))=0 then
RaiseLastOSError
else
EnvStrLength :=(mbi.RegionSize -(ULONG_PTR(Pointer(Rtl32.Environment)) - ULONG_PTR(mbi.BaseAddress)));
SetLength(EnvStrBlock, EnvStrLength);
//read the content of the env. variables block
if not ReadProcessMemory(ProcessHandle, Pointer(Rtl32.Environment), @EnvStrBlock[0], EnvStrLength, lpNumberOfBytesRead) then
RaiseLastOSError
else
Result:=TEncoding.Unicode.GetString(EnvStrBlock);
end;
end;
end
else
RaiseLastOSError;
end;
{$ENDIF}
finally
CloseHandle(ProcessHandle);
end;
finally
CloseHandle(TokenHandle);
end;
end
else
RaiseLastOSError;
end;
function GetEnvVarsPidList(dwProcessId : DWORD): TStringList;
var
PEnvVars: PChar;
PEnvEntry: PChar;
begin
Result:=TStringList.Create;
PEnvVars := PChar(GetEnvVarsPid(dwProcessId));
PEnvEntry := PEnvVars;
while PEnvEntry^ <> #0 do
begin
Result.Add(PEnvEntry);
Inc(PEnvEntry, StrLen(PEnvEntry) + 1);
end;
end;
Var
EnvVars : TStringList;
begin
ReportMemoryLeaksOnShutdown:=True;
try
//Pass a valid pid here
EnvVars:=GetEnvVarsPidList(5732);
try
Writeln(EnvVars.Text);
finally
EnvVars.Free;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Readln;
end.






