[network] added easy dnsresolver

Quick.Console.pas

@@ -876,7 +876,7 @@ begin
                 pBuffer[dRead] := #0;
                 OemToCharA(pBuffer,dBuffer);
                 if Assigned(CallBack) then CallBack(dBuffer);
-                if Assigned(OutputLines) then OutputLines.Add(dBuffer);
+                if Assigned(OutputLines) then OutputLines.Add(string(dBuffer));
               until (dRead < CReadBuffer);
             end;
             //Application.ProcessMessages;

Quick.Json.Serializer.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Version     : 1.12
   Created     : 21/05/2018
-  Modified    : 03/10/2021
+  Modified    : 27/12/2021
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -131,16 +131,18 @@ type
     fUseBase64Stream : Boolean;
     fUseNullStringsAsEmpty : Boolean;
     function GetValue(aAddr: Pointer; aType: TRTTIType): TValue; overload;
+    {$IFDEF FPC}
     function GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue; overload;
+    {$ENDIF}
     function IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
-    function GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
+    //function GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
     function GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
     {$IFNDEF FPC}
     function GetFieldValueFromRecord(const aValue : TValue; const FieldName : string) : TValue;
     {$ENDIF}
+    {$IFDEF FPC}
     procedure SetPropertyValue(Instance : TObject; aPropInfo : PPropInfo; aValue : TValue); overload;
     procedure SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue); overload;
-    {$IFDEF FPC}
     function FloatProperty(aObject : TObject; aPropInfo: PPropInfo): string;
     function GetPropType(aPropInfo: PPropInfo): PTypeInfo;
     procedure LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
@@ -210,7 +212,7 @@ type
     property UseEnumNames : Boolean read fUseEnumNames write SetUseEnumNames;
     property UseJsonCaseSense : Boolean read fUseJsonCaseSense write SetUseJsonCaseSense;
     property UseBase64Stream : Boolean read fUseBase64Stream write SetUseBase64Stream;
-    property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write fUseNullStringsAsEmpty;
+    property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write SetUseNullStringsAsEmpty;
     function JsonToObject(aType : TClass; const aJson: string) : TObject; overload;
     function JsonToObject(aObject : TObject; const aJson: string) : TObject; overload;
     function JsonStreamToObject(aObject : TObject; aJsonStream : TStream) : TObject;
@@ -463,6 +465,7 @@ begin
   finally
     stream.Free;
   end;
+  Result := aObject;
 end;
 
 constructor TRTTIJson.Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
@@ -587,7 +590,7 @@ begin
             if IsGenericList(propvalue.AsObject) then DeserializeList(propvalue.AsObject,'List',TJSONObject(aJson.GetValue(propertyname)))
             else Result := DeserializeProperty(Result,propertyname,rProp,aJson);
           end
-          else if IsGenericXArray(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF}) then
+          else if IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
           begin
             DeserializeXArray(Result,propvalue,rProp,propertyname,aJson);
           end
@@ -1089,49 +1092,49 @@ begin
   Result := nil;
 end;
 
-function TRTTIJson.GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
-var
-  pinfo : PPropInfo;
-begin
-  Result := nil;
-  pinfo := GetPropInfo(Instance,PropertyName);
-  if pinfo = nil then raise EJsonSerializeError.CreateFmt('Property "%s" not found!',[PropertyName]);
-  case pinfo.PropType^.Kind of
-    tkInteger : Result := GetOrdProp(Instance,pinfo);
-    tkInt64 : Result := GetInt64Prop(Instance,PropertyName);
-    tkFloat : Result := GetFloatProp(Instance,PropertyName);
-    tkChar : Result := Char(GetOrdProp(Instance,PropertyName));
-    {$IFDEF FPC}
-    tkWString : Result := GetWideStrProp(Instance,PropertyName);
-    tkSString,
-    tkAString,
-    {$ELSE}
-    tkWString,
-    {$ENDIF}
-    tkLString : Result := GetStrProp(Instance,pinfo);
-    {$IFDEF FPC}
-    tkEnumeration :
-      begin
-        if fUseEnumNames then Result := GetEnumName(pinfo.PropType,GetOrdProp(Instance,PropertyName))
-          else Result := GetOrdProp(Instance,PropertyName);
-      end;
-    {$ELSE}
-    tkEnumeration :
-      begin
-        if fUseEnumNames then Result := GetEnumName(@pinfo.PropType,GetOrdProp(Instance,PropertyName))
-          else Result := GetOrdProp(Instance,PropertyName);
-      end;
-    {$ENDIF}
-    tkSet : Result := GetSetProp(Instance,pinfo,True);
-    {$IFNDEF FPC}
-    tkClass :
-    {$ELSE}
-    tkBool : Result := Boolean(GetOrdProp(Instance,pinfo));
-    tkObject :
-    {$ENDIF} Result := GetObjectProp(Instance,pinfo);
-    tkDynArray : Result := GetDynArrayProp(Instance,pinfo);
-  end;
-end;
+//function TRTTIJson.GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
+//var
+//  pinfo : PPropInfo;
+//begin
+//  Result := nil;
+//  pinfo := GetPropInfo(Instance,PropertyName);
+//  if pinfo = nil then raise EJsonSerializeError.CreateFmt('Property "%s" not found!',[PropertyName]);
+//  case pinfo.PropType^.Kind of
+//    tkInteger : Result := GetOrdProp(Instance,pinfo);
+//    tkInt64 : Result := GetInt64Prop(Instance,PropertyName);
+//    tkFloat : Result := GetFloatProp(Instance,PropertyName);
+//    tkChar : Result := Char(GetOrdProp(Instance,PropertyName));
+//    {$IFDEF FPC}
+//    tkWString : Result := GetWideStrProp(Instance,PropertyName);
+//    tkSString,
+//    tkAString,
+//    {$ELSE}
+//    tkWString,
+//    {$ENDIF}
+//    tkLString : Result := GetStrProp(Instance,pinfo);
+//    {$IFDEF FPC}
+//    tkEnumeration :
+//      begin
+//        if fUseEnumNames then Result := GetEnumName(pinfo.PropType,GetOrdProp(Instance,PropertyName))
+//          else Result := GetOrdProp(Instance,PropertyName);
+//      end;
+//    {$ELSE}
+//    tkEnumeration :
+//      begin
+//        if fUseEnumNames then Result := GetEnumName(@pinfo.PropType,GetOrdProp(Instance,PropertyName))
+//          else Result := GetOrdProp(Instance,PropertyName);
+//      end;
+//    {$ENDIF}
+//    tkSet : Result := GetSetProp(Instance,pinfo,True);
+//    {$IFNDEF FPC}
+//    tkClass :
+//    {$ELSE}
+//    tkBool : Result := Boolean(GetOrdProp(Instance,pinfo));
+//    tkObject :
+//    {$ENDIF} Result := GetObjectProp(Instance,pinfo);
+//    tkDynArray : Result := GetDynArrayProp(Instance,pinfo);
+//  end;
+//end;
 
 function TRTTIJson.GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
 var
@@ -1156,6 +1159,7 @@ begin
 end;
 {$ENDIF}
 
+{$IFDEF FPC}
 procedure TRTTIJson.SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue);
 var
   pinfo : PPropInfo;
@@ -1192,7 +1196,6 @@ begin
   end;
 end;
 
-{$IFDEF FPC}
 procedure TRTTIJson.LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
 type
   TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;
@@ -1298,7 +1301,7 @@ begin
 //            end
             if propvalue.IsObject then jpair.JsonValue := SerializeObject(propvalue.AsObject)
             {$IFNDEF FPC}
-            else if (not propvalue.IsObject) and (IsGenericXArray(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
+            else if (not propvalue.IsObject) and (IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF}))) then
             begin
               jpair.JsonValue := SerializeValue(GetFieldValueFromRecord(propvalue,'fArray'));
             end
@@ -1336,10 +1339,12 @@ begin
   TValue.Make(aAddr,aType.Handle,Result);
 end;
 
+{$IFDEF FPC}
 function TRTTIJson.GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue;
 begin
   TValue.Make(aAddr,aTypeInfo,Result);
 end;
+{$ENDIF}
 
 function TRTTIJson.SerializeValue(const aValue : TValue) : TJSONValue;
 begin
@@ -1453,7 +1458,6 @@ end;
 function TRTTIJson.SerializeStream(aObject: TObject): TJSONValue;
 var
   stream : TStream;
-  json : string;
 begin
   Result := nil;
   try

Quick.Network.pas

@@ -36,7 +36,23 @@ interface
 uses
   Classes,
   SysUtils,
-  Math;
+  Math,
+  IdDNSResolver;
+
+type
+  TDNSResolve = class
+  private
+    fHost : string;
+    fPort : Integer;
+    function ResolveDNS(const aDNS : string; aRegType: TQueryRecordTypes): string;
+  public
+    constructor Create(const aNameServer : string = '8.8.8.8'; aServerPort : Integer = 53);
+    function ResolveA(const aDNS : string): string;
+    function ResolveAAAA(const aDNS : string): string;
+    function ResolveCNAME(const aDNS : string): string;
+    function ResolveNS(const aDNS : string): string;
+    function ResolveTXT(const aDNS : string): string;
+  end;
 
   function IntToIPv4(IPv4: LongWord): string;
   function IPv4ToInt(const IPv4: string) : LongWord;
@@ -130,4 +146,70 @@ begin
   end;
 end;
 
+{ TDNSResolve }
+
+constructor TDNSResolve.Create(const aNameServer : string = '8.8.8.8'; aServerPort : Integer = 53);
+begin
+  fHost := aNameServer;
+  fPort := aServerPort;
+end;
+
+function TDNSResolve.ResolveDNS(const aDNS : string; aRegType: TQueryRecordTypes): string;
+var
+  dnsresolver : TIdDNSResolver;
+begin
+  Result := '';
+  dnsresolver := TIdDNSResolver.Create(nil);
+  try
+    dnsresolver.Host := fHost;
+    dnsresolver.Port := fPort;
+    dnsresolver.QueryResult.Clear;
+    dnsresolver.QueryType := [aRegType];
+    dnsresolver.Resolve(aDNS);
+    if dnsresolver.QueryResult.Count > 0 then
+    begin
+      if dnsresolver.QueryResult[0].RecType = aRegType then
+      begin
+        case aRegType of
+          qtNS : Result := TNSRecord(dnsresolver.QueryResult.Items[0]).HostName;
+          qtA : Result := TARecord(dnsresolver.QueryResult.Items[0]).IPAddress;
+          qtAAAA : Result := TAAAARecord(dnsresolver.QueryResult.Items[0]).Address;
+          qtNAME : Result := TCNRecord(dnsresolver.QueryResult.Items[0]).HostName;
+          qtTXT : Result := TTextRecord(dnsresolver.QueryResult.Items[0]).Text.Text;
+          else raise Exception.Create('Not implemented yet!');
+        end;
+
+      end;
+    end;
+  finally
+    dnsresolver.Free;
+  end;
+end;
+
+function TDNSResolve.ResolveNS(const aDNS : string): string;
+begin
+  Result := ResolveDNS(aDNS,qtNS);
+end;
+
+function TDNSResolve.ResolveA(const aDNS : string): string;
+begin
+  Result := ResolveDNS(aDNS,qtA);
+end;
+
+function TDNSResolve.ResolveAAAA(const aDNS : string): string;
+begin
+  Result := ResolveDNS(aDNS,qtAAAA);
+end;
+
+
+function TDNSResolve.ResolveCNAME(const aDNS : string): string;
+begin
+  Result := ResolveDNS(aDNS,qtName);
+end;
+
+function TDNSResolve.ResolveTXT(const aDNS : string): string;
+begin
+  Result := ResolveDNS(aDNS,qtTXT);
+end;
+
 end.