TDataSetSQLStatement c esempio di “class helper” in Delphi.

by Ivan Revelli
in Delphi, Posts, Programmazione
on April 7, 2023

Helpers are a way to extend a class without using inheritance, which is also useful for records that don’t allow inheritance at all.

Official documentation is available at:

https://docwiki.embarcadero.com/RADStudio/Sydney/en/Class_and_Record_Helpers_(Delphi).

I often found myself creating code to export a dataset or a single record with its values in an SQL statement, and every time I wrote the code. Below I created a “class helper” for the dataset class that allows you to generate “insert/update/delete” statements.

Basically, once added to your units, the descendant TDataSets will have the “SQLStatement” and “SQLStatements” methods available to generate the desired SQL code.

If on a form we have a dataset called “DSrticoli” and we wanted to get the “Insert” code for the current record, it would be enough to write:

FDQuery1.SQLStatement(TSQLStatementType.SQLInsert,'ARTICOLI',[]);

1	FDQuery1.SQLStatement(TSQLStatementType.SQLInsert,'ARTICOLI',[]);

Helper class code:

unit uDataSetSSQLHelper;

interface
uses System.SysUtils, System.Classes, System.IOUtils,DB;

type
  TSQLStatementType = (SQLInsert,SQLUpdate,SQLDelete);


  TDataSetSQLHelper = class helper for TDataset
  private
    function dataTypeSupported(AFieldType : TFieldType) : Boolean;
    function formatFieldValue(AFld : TField) : String;
    function whereCondition(KeyFieldNames : TArray<string>; addWhereStmt : Boolean = false):String;
    function ckKeyFields(KeyFieldNames : TArray<string>) : boolean;
    function getInsertStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;
    function getUpdateStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;
    function getDeleteStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;
  public
    function SQLStatement(StatementType: TSQLStatementType; TableName: String;KeyFieldNames : TArray<string> = []) : String;
    function SQLStatements(StatementType: TSQLStatementType; TableName: String;KeyFieldNames : TArray<string> = []) : String;
  end;


implementation

{ TDataSetSQLHelper }



{ TDataSetSQLHelper }

function TDataSetSQLHelper.ckKeyFields(KeyFieldNames: TArray<string>): boolean;
var
  LKeyFieldName: string;

begin
 if not Self.Active then
  raise Exception.Create('Dataset is not active!!');

 result := true;
 for LKeyFieldName in KeyFieldNames do
  begin
   if Self.FindField(LKeyFieldName) = nil then
    begin
     result := false;
     raise Exception.Create('KeyFiled "' + LKeyFieldName + '" not found in dataset fields');
    end;
  end;

end;

function TDataSetSQLHelper.dataTypeSupported(AFieldType: TFieldType): Boolean;
begin
 Result := not(AFieldType in [
    ftBlob,
    ftMemo,
    ftGraphic,
    ftFmtMemo,
    ftParadoxOle,
    ftDBaseOle,
    ftTypedBinary,
    ftCursor,
    ftFixedChar,
    ftWideString,
    ftADT,
    ftArray,
    ftReference,
    ftDataSet,
    ftOraBlob,
    ftOraClob,
    ftVariant,
    ftInterface,
    ftIDispatch,
    ftOraTimeStamp,
    ftOraInterval,
    ftConnection,
    ftParams,
    ftStream,
    ftTimeStampOffset,
    ftObject]);
end;

function TDataSetSQLHelper.formatFieldValue(AFld: TField): String;
var
 FS : TFormatSettings;
begin
  FS.DecimalSeparator := '.';
  FS.CurrencyDecimals := 2;


  if AFld.IsNull then
    result := 'null'
  Else
   begin

      case AFld.DataType of
        ftUnknown: result := '''' + AFld.asString.Replace('''','''''') + '''';
        ftString: result := '''' + AFld.asString.Replace('''','''''') + '''';
        ftSmallint: result := AFld.asString;
        ftInteger: result := AFld.asString;
        ftWord: result := AFld.asString;
        ftBoolean: result := AFld.AsBoolean.ToString(True);
        ftFloat: result := FloatToStr(AFld.asFloat);
        ftCurrency: result := FloatToStr(AFld.asFloat);
        ftBCD: result := FloatToStr(AFld.asFloat);
        ftDate: result := '(cast(''' + FormatDateTime('mm/dd/yyyy',AFld.AsDateTime) + ''' as DATE))';
        ftTime: result := '(cast(''' + FormatDateTime('hh:mm:ss',AFld.AsDateTime) + ''' as TIME))';
        ftDateTime: result := '(cast(''' + FormatDateTime('mm/dd/yyyy hh:mm:ss',AFld.AsDateTime) + ''' as TIMESTAMP))';
        ftBytes: AFld.asString;
        ftVarBytes: AFld.asString;
        ftAutoInc: AFld.asString;

        ftLargeint: result := AFld.asString;

        ftGuid: result := AFld.asString;
        ftTimeStamp: result := '(cast(''' + FormatDateTime('mm/dd/yyyy hh:mm:ss',AFld.AsDateTime) + ''' as TIMESTAMP))';
        ftFMTBcd: FloatToStr(AFld.asFloat);
        ftFixedWideChar: result := '''' + AFld.asString.Replace('''','''''') + '''';
        ftWideMemo: result := '''' + AFld.asString.Replace('''','''''') + '''';

        ftLongWord: result := AFld.asString;
        ftShortint: result := AFld.asString;
        ftByte: result := AFld.asString;
        ftExtended: FloatToStr(AFld.asFloat);
        ftSingle:  FloatToStr(AFld.asFloat);
      end;
   end;

end;

function TDataSetSQLHelper.getDeleteStatement(TableName: String;
  KeyFieldNames: TArray<string>): String;
begin
 ckKeyFields(KeyFieldNames);
 result := 'delete from ' + TableName + #10#13 + whereCondition(KeyFieldNames,true);
end;

function TDataSetSQLHelper.getInsertStatement(TableName: String;
  KeyFieldNames: TArray<string>): String;
var
  I: Integer;
  LFieldList: String;
  LValueList: String;
begin
 LFieldList := '';
 LValueList := '';
 ckKeyFields(KeyFieldNames);
 result := 'insert into ' + TableName  + '(' + #10#13;

 for I := 0 to Self.FieldCount-1 do
  begin
   if dataTypeSupported(Self.Fields[I].DataType) then
    begin
     if LFieldList = '' then
       LFieldList := Self.Fields[I].FieldName
     else
       LFieldList := LFieldList + ',' + Self.Fields[I].FieldName;
    end;
  end;
 result := result + LFieldList +  ')values(' + #10#13;
 for I := 0 to Self.FieldCount-1 do
  begin
   if dataTypeSupported(Self.Fields[I].DataType) then
    begin
     if LValueList = '' then
       LValueList := formatFieldValue(Self.Fields[I])
     else
       LValueList := LValueList + ',' + formatFieldValue(Self.Fields[I]);
    end;
  end;

 result := result + LValueList + ')';

end;

function TDataSetSQLHelper.getUpdateStatement(TableName: String;
  KeyFieldNames: TArray<string>): String;
var
  I: Integer;
begin
 ckKeyFields(KeyFieldNames);

 Result := 'update ' + TableName + ' set ';
 for I := 0 to Self.FieldCount-1 do
  begin
   if dataTypeSupported(Self.Fields[I].DataType) then
    begin
      Result := Result + #1013 + Self.Fields[I].Name + ' = ' + formatFieldValue(Self.Fields[I]);
      if I < Self.FieldCount-1 then
       Result := Result + ' ,';
    end;
  end;

 Result := Result + #10#13 + whereCondition(KeyFieldNames);

end;

function TDataSetSQLHelper.SQLStatement(StatementType: TSQLStatementType;
  TableName: String; KeyFieldNames: TArray<string>): String;
begin
 case StatementType of
   SQLInsert: result := getInsertStatement(TableName,KeyFieldNames);
   SQLUpdate: result := getUpdateStatement(TableName,KeyFieldNames);
   SQLDelete: result := getDeleteStatement(TableName,KeyFieldNames);
 end;
end;




function TDataSetSQLHelper.SQLStatements(StatementType: TSQLStatementType;
  TableName: String; KeyFieldNames: TArray<string>): String;
begin
 Result := '';
 Self.First;
 while not Self.Eof do
  begin
    if Result = '' then
      Result := SQLStatement(StatementType,TableName,KeyFieldNames) + ';'
    Else
      Result := Result + #10#13 + SQLStatement(StatementType,TableName,KeyFieldNames) + ';';

    Self.Next;
  end;
end;

function TDataSetSQLHelper.whereCondition(
  KeyFieldNames: TArray<string>; addWhereStmt : Boolean = false): String;
var
  I: Integer;
  LFieldName: string;


 function addCondition(KeyFieldName : String) : String;
  begin
    result := '(' + KeyFieldName + ' = ' + formatFieldValue(Self.FieldByName(KeyFieldName)) + ')';
  end;


begin
 result := '';
 if (KeyFieldNames = nil)or(Length(KeyFieldNames) = 0) then
  begin
   for I := 0 to Self.FieldCount-1 do
    begin
     if dataTypeSupported(Self.Fields[I].DataType) then
     begin
       LFieldName := Self.Fields[I].FieldName;
       if result = '' then
        result := addCondition(LFieldName) + #10#13
       else
        result := result + 'and' + addCondition(LFieldName) + #10#13;
     end
    end
  end
 else
  begin
   for LFieldName in KeyFieldNames do
    begin
     if result = '' then
      result := addCondition(LFieldName) + #10#13
     else
      result := result + 'and' + addCondition(LFieldName) + #10#13;
    end
  end;

 if addWhereStmt then
  result := ' where (' + result + ')';
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

unit uDataSetSSQLHelper;

interface

uses System.SysUtils, System.Classes, System.IOUtils,DB;

type

TSQLStatementType = (SQLInsert,SQLUpdate,SQLDelete);

TDataSetSQLHelper = class helper for TDataset

private

function dataTypeSupported(AFieldType : TFieldType) : Boolean;

function formatFieldValue(AFld : TField) : String;

function whereCondition(KeyFieldNames : TArray<string>; addWhereStmt : Boolean = false):String;

function ckKeyFields(KeyFieldNames : TArray<string>) : boolean;

function getInsertStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;

function getUpdateStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;

function getDeleteStatement(TableName: String;KeyFieldNames : TArray<string> = []) : String;

public

function SQLStatement(StatementType: TSQLStatementType; TableName: String;KeyFieldNames : TArray<string> = []) : String;

function SQLStatements(StatementType: TSQLStatementType; TableName: String;KeyFieldNames : TArray<string> = []) : String;

end;

implementation

{ TDataSetSQLHelper }

function TDataSetSQLHelper.ckKeyFields(KeyFieldNames: TArray<string>): boolean;

var

LKeyFieldName: string;

begin

if not Self.Active then

raise Exception.Create('Dataset is not active!!');

result := true;

for LKeyFieldName in KeyFieldNames do

begin

if Self.FindField(LKeyFieldName) = nil then

begin

result := false;

raise Exception.Create('KeyFiled "' + LKeyFieldName + '" not found in dataset fields');

end;

function TDataSetSQLHelper.dataTypeSupported(AFieldType: TFieldType): Boolean;

begin

Result := not(AFieldType in [

ftBlob,

ftMemo,

ftGraphic,

ftFmtMemo,

ftParadoxOle,

ftDBaseOle,

ftTypedBinary,

ftCursor,

ftFixedChar,

ftWideString,

ftADT,

ftArray,

ftReference,

ftDataSet,

ftOraBlob,

ftOraClob,

ftVariant,

ftInterface,

ftIDispatch,

ftOraTimeStamp,

ftOraInterval,

ftConnection,

ftParams,

ftStream,

ftTimeStampOffset,

ftObject]);

end;

function TDataSetSQLHelper.formatFieldValue(AFld: TField): String;

var

FS : TFormatSettings;

begin

FS.DecimalSeparator := '.';

FS.CurrencyDecimals := 2;

if AFld.IsNull then

result := 'null'

Else

begin

case AFld.DataType of

ftUnknown: result := '''' + AFld.asString.Replace('''','''''') + '''';

ftString: result := '''' + AFld.asString.Replace('''','''''') + '''';

ftSmallint: result := AFld.asString;

ftInteger: result := AFld.asString;

ftWord: result := AFld.asString;

ftBoolean: result := AFld.AsBoolean.ToString(True);

ftFloat: result := FloatToStr(AFld.asFloat);

ftCurrency: result := FloatToStr(AFld.asFloat);

ftBCD: result := FloatToStr(AFld.asFloat);

ftDate: result := '(cast(''' + FormatDateTime('mm/dd/yyyy',AFld.AsDateTime) + ''' as DATE))';

ftTime: result := '(cast(''' + FormatDateTime('hh:mm:ss',AFld.AsDateTime) + ''' as TIME))';

ftDateTime: result := '(cast(''' + FormatDateTime('mm/dd/yyyy hh:mm:ss',AFld.AsDateTime) + ''' as TIMESTAMP))';

ftBytes: AFld.asString;

ftVarBytes: AFld.asString;

ftAutoInc: AFld.asString;

ftLargeint: result := AFld.asString;

ftGuid: result := AFld.asString;

ftTimeStamp: result := '(cast(''' + FormatDateTime('mm/dd/yyyy hh:mm:ss',AFld.AsDateTime) + ''' as TIMESTAMP))';

ftFMTBcd: FloatToStr(AFld.asFloat);

ftFixedWideChar: result := '''' + AFld.asString.Replace('''','''''') + '''';

ftWideMemo: result := '''' + AFld.asString.Replace('''','''''') + '''';

ftLongWord: result := AFld.asString;

ftShortint: result := AFld.asString;

ftByte: result := AFld.asString;

ftExtended: FloatToStr(AFld.asFloat);

ftSingle: FloatToStr(AFld.asFloat);

end;

function TDataSetSQLHelper.getDeleteStatement(TableName: String;

KeyFieldNames: TArray<string>): String;

begin

ckKeyFields(KeyFieldNames);

result := 'delete from ' + TableName + #10#13 + whereCondition(KeyFieldNames,true);

end;

function TDataSetSQLHelper.getInsertStatement(TableName: String;

KeyFieldNames: TArray<string>): String;

var

I: Integer;

LFieldList: String;

LValueList: String;

begin

LFieldList := '';

LValueList := '';

ckKeyFields(KeyFieldNames);

result := 'insert into ' + TableName + '(' + #10#13;

for I := 0 to Self.FieldCount-1 do

begin

if dataTypeSupported(Self.Fields[I].DataType) then

begin

if LFieldList = '' then

LFieldList := Self.Fields[I].FieldName

else

LFieldList := LFieldList + ',' + Self.Fields[I].FieldName;

end;

result := result + LFieldList + ')values(' + #10#13;

for I := 0 to Self.FieldCount-1 do

begin

if dataTypeSupported(Self.Fields[I].DataType) then

begin

if LValueList = '' then

LValueList := formatFieldValue(Self.Fields[I])

else

LValueList := LValueList + ',' + formatFieldValue(Self.Fields[I]);

end;

result := result + LValueList + ')';

end;

function TDataSetSQLHelper.getUpdateStatement(TableName: String;

KeyFieldNames: TArray<string>): String;

var

I: Integer;

begin

ckKeyFields(KeyFieldNames);

Result := 'update ' + TableName + ' set ';

for I := 0 to Self.FieldCount-1 do

begin

if dataTypeSupported(Self.Fields[I].DataType) then

begin

Result := Result + #1013 + Self.Fields[I].Name + ' = ' + formatFieldValue(Self.Fields[I]);

if I < Self.FieldCount-1 then

Result := Result + ' ,';

end;

Result := Result + #10#13 + whereCondition(KeyFieldNames);

end;

function TDataSetSQLHelper.SQLStatement(StatementType: TSQLStatementType;

TableName: String; KeyFieldNames: TArray<string>): String;

begin

case StatementType of

SQLInsert: result := getInsertStatement(TableName,KeyFieldNames);

SQLUpdate: result := getUpdateStatement(TableName,KeyFieldNames);

SQLDelete: result := getDeleteStatement(TableName,KeyFieldNames);

end;

function TDataSetSQLHelper.SQLStatements(StatementType: TSQLStatementType;

TableName: String; KeyFieldNames: TArray<string>): String;

begin

Result := '';

Self.First;

while not Self.Eof do

begin

if Result = '' then

Result := SQLStatement(StatementType,TableName,KeyFieldNames) + ';'

Else

Result := Result + #10#13 + SQLStatement(StatementType,TableName,KeyFieldNames) + ';';

Self.Next;

end;

function TDataSetSQLHelper.whereCondition(

KeyFieldNames: TArray<string>; addWhereStmt : Boolean = false): String;

var

I: Integer;

LFieldName: string;

function addCondition(KeyFieldName : String) : String;

begin

result := '(' + KeyFieldName + ' = ' + formatFieldValue(Self.FieldByName(KeyFieldName)) + ')';

end;

begin

result := '';

if (KeyFieldNames = nil)or(Length(KeyFieldNames) = 0) then

begin

for I := 0 to Self.FieldCount-1 do

begin

if dataTypeSupported(Self.Fields[I].DataType) then

begin

LFieldName := Self.Fields[I].FieldName;

if result = '' then

result := addCondition(LFieldName) + #10#13

else

result := result + 'and' + addCondition(LFieldName) + #10#13;

end

else

begin

for LFieldName in KeyFieldNames do

begin

if result = '' then

result := addCondition(LFieldName) + #10#13

else

result := result + 'and' + addCondition(LFieldName) + #10#13;

end

end;

if addWhereStmt then

result := ' where (' + result + ')';

end;

end.

TDataSetSQLStatement c esempio di “class helper” in Delphi.

TDataSetSQLStatement c esempio di “class helper” in Delphi.

Ricerca Articolo

Categorie

Synaptica srl