Delphi开发系列（7）：查询数据库并返回数据集

首先放一个连接池组件FDManager1，Create事件代码

procedure TServerContainer1.DataModuleCreate(Sender: TObject);
var
  iSection: Integer;
  IniFileDB : TIniFile;
  DBSource : TStringList;
  oParams  : TStrings;
  //数据库数据源
  DBAlias : string;
  DBServer : string;
  DBPort : string;
  DBName : string;
  UserName : string;
  DBProvider : string;
  IsEncryption : string;
  UserPwd : string;
  PoolSize : String;
  strErrMsg : string;
begin
  //*****初始化*****
  IniFileDB:=TIniFile.Create('/root/config.ini');
  DBSource := TStringList.Create;
  oParams := TStringList.Create;
  try
    try
      IniFileDB.ReadSections(DBSource);

      for iSection:=0 to DBSource.Count-1 do
        begin
          DBAlias := DBSource.Strings[iSection];
          DBServer := IniFileDB.ReadString(DBAlias,'DBServer','');
          DBPort := IniFileDB.ReadString(DBAlias,'DBPort','');
          DBName := IniFileDB.ReadString(DBAlias,'DBName','');
          UserName := IniFileDB.ReadString(DBAlias,'UserName','');
          DBProvider := IniFileDB.ReadString(DBAlias,'DBProvider','');
          IsEncryption := IniFileDB.ReadString(DBAlias,'IsEncryption','');
          UserPwd := IniFileDB.ReadString(DBAlias,'UserPwd','');
          PoolSize := IniFileDB.ReadString(DBAlias,'PoolSize','20');
          if  DBProvider.ToLower.Equals('mysql') then
            begin
              oParams.Clear;
              oParams.Add('DriverID='+DBProvider);
              oParams.Add('CharacterSet=utf8');
              oParams.Add('Server='+DBServer);
              oParams.Add('Port='+DBPort);
              oParams.Add('Database='+DBName);
              oParams.Add('User_Name='+UserName);
              oParams.Add('Password='+UserPwd);
              oParams.Add('POOL_CleanupTimeout=36000');
              oParams.Add('POOL_ExpireTimeout=600000');
              oParams.Add('POOL_MaximumItems='+PoolSize);
              oParams.Add('Pooled=True');
              FDManager1.Close;
              FDManager1.AddConnectionDef(DBAlias,'MySQL',oParams);

            end;

          if  DBProvider.ToLower.Equals('oracle') then
            begin
              oParams.Clear;
              oParams.Add(Format('Database=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(HOST=%s)(PORT=%s))(CONNECT_DATA=(SERVER=dedicated)(SERVICE_NAME=%s)))',[DBServer,DBPort,DBName]));
              oParams.Add('CharacterSet=UTF8');
              oParams.Add('User_Name='+UserName);
              oParams.Add('Password='+UserPwd);
              oParams.Add('POOL_CleanupTimeout=36000');
              oParams.Add('POOL_ExpireTimeout=600000');
              oParams.Add('POOL_MaximumItems='+PoolSize);
              oParams.Add('Pooled=True');
//              oParams.Add('CleanupTimeout=0');
//              oParams.Add('ExpireTimeout=0');
//              oParams.Add('PoolMaximumItems=20');
//              oParams.Add('Pooled=True');
              FDManager1.AddConnectionDef(DBAlias, 'Ora', oParams);
            end;
        end;
      except
        on E: Exception do
          begin
            strErrMsg := 'TLSMWSMagicFrame.GetXMLData: ' + E.Message;
            Writeln(strErrMsg);
          end;
      end;
  finally
    DBSource.Free;
    oParams.Free;
  end;
end;

ServerMethodsUnit加入如下控件，并实现查询接口

function TServerMethods1.DBTable(Value: string): string;
var
  strSQL: string;
  DBAlias: string;
  strErrMsg : string;
  JSData: string;
  AStream: TStringStream;
begin
  strSQL := GetInvocationMetadata.QueryParams.Values['strSQL'];
  DBAlias := GetInvocationMetadata.QueryParams.Values['DBAlias'];
  FDConnection.ConnectionDefName := DBAlias;
  AStream := TStringStream.Create('', TEncoding.UTF8);
  try
    try
      FDConnection.Connected := True;
      FDQuery.Connection := FDConnection;
      FDQuery.SQL.Text := strSQL;
      FDQuery.Prepared := true;
      FDQuery.Open;

      FDQuery.SaveToStream(AStream, sfJSON);
      JSData := AStream.DataString;

      JSData := gFun.Encrypt(JSData, CONST_SM4_KEY);
//      JSData := gFun.Compress(JSData);
//      JSData := gFun.sm4EcbEncrypt(JSData, CONST_SM4_KEY);

    except
      on E: Exception do
      begin
        strErrMsg := 'TServerMethods1.EchoString: ' + E.Message;
      end;
    end;
    Result := JSData;
  finally
    AStream.Free;
  end;
end;

POST获取到的数据：

返回结果被DataSnap加工了，增加如下代码再试：

procedure TWebModule1.DSHTTPWebDispatcher1FormatResult(Sender: TObject;
  var ResultVal: TJSONValue; const Command: TDBXCommand; var Handled: Boolean);
var
  JSONValue: TJSONValue;
begin
  Handled := True;
  JSONValue := ResultVal;
  ResultVal := TJSONArray(JSONValue).Get(0);
  TJSONArray(JSONValue).Remove(0);
  JSONValue.Free;
end;

还有转义符号\，把这个代码单独拷贝出来加入到工程中（从Delphi的安装目录中查找）再改代码再试：

修改procedure TDSJsonResponseHandler.GetCommandResponse(Command: TDBXCommand; out Response: TJSONValue;
                                                    out ResponseStream: TStream);方法：

            //Changed by laoxiami
            JsonParam := TJSONObject.ParseJSONValue(Command.Parameters[I].Value.AsString) as TJSONValue;
//            JsonParam := TDBXJSONTools.DBXToJSON(Command.Parameters[I].Value,
//                              Command.Parameters[I].DataType, FDSService.LocalConnection);

再次POST查询数据已经正确（os和data是我的的加密函数封装的结果）：