PageRenderTime 29ms CodeModel.GetById 24ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

/SystemManager/CodeEngineUnit/uCnCeCommon.pas

https://github.com/qriver/Delphi2010
Pascal | 950 lines | 711 code | 107 blank | 132 comment | 41 complexity | d3a580be4616cdb8923e0b7a0a23b96f MD5 | raw file
  1{******************************************************************************}
  2{                       CnPack For Delphi/C++Builder                           }
  3{                     ????????????????                         }
  4{                   (C)Copyright 2001-2007 CnPack ???                       }
  5{                   ------------------------------------                       }
  6{                                                                              }
  7{            ?????????????????? CnPack ???????        }
  8{        ???????????                                                }
  9{                                                                              }
 10{            ?????????????????????????????        }
 11{        ?????????????????????? CnPack ?????        }
 12{                                                                              }
 13{            ??????????????? CnPack ??????????        }
 14{        ?????????????                                            }
 15{                                                                              }
 16{            ?????http://www.cnpack.org                                   }
 17{            ?????master@cnpack.org                                       }
 18{                                                                              }
 19{******************************************************************************}
 20
 21unit uCnCeCommon;
 22{* |<PRE>
 23================================================================================
 24* ???????????
 25* ?????Delphi ?????????
 26* ?????SkyJacker
 27* ?    ???????????????????????
 28* ?????WinXP sp2  + Delphi 6.0 up2
 29* ??????
 30* ? ? ????????????????????
 31* ?????$Id: uCnCeCommon.pas,v 1.0 2007/03/06 14:36:27 SkyJacker Exp $
 32* ?????2007.03.14
 33*               ?????????
 34================================================================================
 35|</PRE>}
 36
 37interface
 38
 39uses
 40  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 41  Dialogs, StdCtrls, StrUtils;
 42
 43type
 44  TStringArray = array of string;  
 45
 46const
 47
 48//------------------------------------------------------------------------------
 49// ??????
 50//------------------------------------------------------------------------------
 51
 52  cnDBLinkUdl = 'data\DbLink.udl'; // ?????
 53  cnTemplatePath ='data\CETemplates\';
 54  cnTemplateDpr = cnTemplatePath + 'Project1.dpr';
 55  cnTemplatePas = cnTemplatePath + 'Unit1.pas';
 56  cnTemplateDfm = cnTemplatePath + 'Unit1.dfm';
 57
 58  cnTempPath: string = 'data\temp\';
 59  cnCESetIni: string = 'data\ceset.ini';
 60  CRLF = #13#10;
 61  NL = '';
 62
 63//------------------------------------------------------------------------------
 64// ??????
 65// ?: ????????????, ??????????
 66//------------------------------------------------------------------------------
 67
 68  // ????
 69  cnPrgName = '<#PrgName>';         // ????
 70  cnUnitName = '<#UnitName>';       // ????
 71  cnFormClass = '<#TFormName>';     // ?????
 72  cnFormName = '<#FormName>';       // ?????
 73  cnFormCaption = '<#FormCaption>'; // ??????
 74
 75  // ??????????
 76  cnAddUseGlobal = '<#AddUseGlobal>';      // ???? uses ???
 77  cnAddUseLocal = '<#AddUseLocal>';        // ???? uses ???
 78  cnAddControl  = '<#AddControl>';         // ????
 79  cnAddControlDfm = '<#AddControlDfm>';    // ??????? dfm
 80  cnAddPrivateData  = '<#AddPrivateData>'; // ????????
 81  cnAddPrivateFunc  = '<#AddPrivateFunc>'; // ???????????
 82  cnAddPublicData   = '<#AddPublicData>';  // ????????
 83  cnAddPublicFunc   = '<#AddPublicFunc>';  // ???????????
 84
 85  // ??????????????????
 86  cnAddGlobalFunc = '<#AddGlobalFunc>';     // ????????
 87  cnAddFormFunc = '<#AddFormFunc>';         // ???????
 88  cnAddFormFuncHead = '<#AddFormFuncHead>'; // ??????????
 89
 90  //????
 91  cnTableName = '<#TableName>'; // ?????????
 92  cnPkFieldName = '<#PkFieldName>'; // ?????????
 93
 94  // ???????
 95  SDELI = '?'; // ????????(????????? ? ???????)
 96  SP1 = ' ';   // ?? 1 ~ 8 ???
 97  SP2 = SP1 + SP1;
 98  SP4 = SP2 + SP2;
 99  SP6 = SP4 + SP2;
100  SP8 = SP6 + SP2;
101
102  // ???? Sql ?????
103  cnFmtStr = ' ''''%s''''';
104  cnFmtInt = ' %d';
105  cnFmtFlt = ' %f';
106
107  // ???????
108  ExtDpr = '.dpr';
109  ExtPas = '.pas';
110  ExtDfm = '.dfm';
111  UnSaveFlag = ' *';
112
113var
114
115//------------------------------------------------------------------------------
116// ??????
117//------------------------------------------------------------------------------
118
119  BtnText: array[0..2] of string= ('??','??','??');
120  AppTitle: string = 'CnPack Delphi ???? V1.0';
121  AppPath: string;
122  TemplatePath: string;
123  FileSavePath: string;
124  bMySql: Boolean;
125  lstTableName: TStrings;
126  SqlInteger, SqlFloat, SqlString: TStringArray;
127
128//------------------------------------------------------------------------------
129// ??????
130//------------------------------------------------------------------------------
131
132  PrgName: string = 'Project1';
133  MyUnitName: string = 'Unit1';
134  FormClass: string = 'TForm1';
135  FormName: string = 'Form1';
136  FormCaption: string = 'Form1';
137
138  TableName: String ='MyTableName';
139  PK_FieldName:String ='PK_FieldName';
140
141
142  // ??????????
143  AddUseGlobal: string;       // ???? uses ???
144  AddUseLocal: string;        // ???? uses ???
145  AddControl: TStrings;       // ????
146  AddCdsControl: TStrings;    // ??TClientDataset??
147  AddCdsFieldControl: TStrings;    // ??TClientDataset??
148  AddControlDfm: TStrings;    // ??????? dfm
149  AddPrivateData: TStrings;   // ????????
150  AddPrivateFunc: TStrings;   // ???????????
151  AddPublicData: TStrings;    // ????????
152  AddPublicFunc: TStrings;    // ???????????
153
154  // ??????????????????
155  AddGlobalFunc: TStrings;    // ????????
156  AddFormFunc: TStrings;      // ???????
157  AddFormFuncHead: TStrings;  // ??????????
158
159//------------------------------------------------------------------------------
160// ????
161//------------------------------------------------------------------------------
162
163procedure EnterPress(AFrm: TForm; var Key: Char);
164{* ???? Tab}
165
166function StrToDfmFmt(const AStr: string): string;
167{* ?????????? Delphi Dfm ???}
168
169function iGetDelimiterIndex(const AStr: string; n: integer): integer;
170{* ??????? n ???????}
171
172function GetDelimiterStr(const AStr: string; m: integer; n: integer): string;
173{* ??????? m ?????? n ?????????(m<n)}
174
175function GetDelimiterCount(const AStr, ADeli:string):integer;
176{* ???????}
177
178function IsExistStr(const AStr: string;var AStrList: TStringArray): Boolean;
179{* ???????????????}
180
181//------------------------------------------------------------------------------
182// ????????
183//------------------------------------------------------------------------------
184
185procedure CEGenTLabel(ANo, ALeft, ATop: Integer; const ACaption: string);
186{* ???? TLabel}
187
188procedure CEGenTEdit(ALeft, ATop: Integer; const AEdtName: string);
189{* ???? TEdit}
190
191procedure CEGenTClientDataSet (const ATableName,AColumnName,AChineseName,AType,ASize: string);
192{* ???? TClientDataSet}
193
194procedure CEGenTButton(ALeft, ATop: Integer; const AName, ACaption: string);
195{* ???? TButton}
196
197procedure CEGenTADOConnection(ALeft, ATop: Integer; const AName: string);
198{* ???? TADOConnection}
199
200procedure CEGenTADOQuery(ALeft, ATop: Integer; const AName, AAdoCon: string);
201{* ???? TADOQuery}
202
203procedure CEGenShowTableRec(const AFormName, ATableName, AConQry: string; var ColumnsTypes: string);
204{* ???????????, ???????}
205
206procedure CEGenDelTableRec(const AFormName, ATableName, AColumnName, AConQry, AAdoCon: string);
207{* ???????????}
208
209procedure CEGenInsertTableRec(const AFormName, ATableName, AConQry, AAdoCon: string; var ColumnsTypes: string);
210{* ???????????}
211
212procedure CEGenUpdateTableRec(const AFormName, ATableName, AColumnName, AConQry, AAdoCon: string; var ColumnsTypes: string);
213{* ???????????}
214
215implementation
216
217//------------------------------------------------------------------------------
218// ????
219//------------------------------------------------------------------------------
220
221// ???? Tab
222procedure EnterPress(AFrm: TForm; var Key: Char);
223begin
224  if Key = #13 then
225  begin
226    Key := #0;
227    AFrm.Perform(WM_NEXTDLGCTL, 0, 0);
228  end;
229end;
230
231// ?????????? Delphi ? Dfm ??
232function StrToDfmFmt(const AStr: string): string;
233const
234  QM = '''';
235var
236  W: WideString;
237  I: Integer;
238  bEn: Boolean;
239  Len: Integer;
240begin
241  bEn := False;
242  W := AStr;
243  Len := Length(W);
244  for I:=1 to Len do
245  begin
246    if Ord(W[i])>127 then // ?????? ascii????????
247    begin
248      if bEn then
249        Result := Result + QM;
250
251      Result := Result + '#' + IntToStr(Ord(W[I]));
252      bEn := false;
253    end
254    else
255    begin
256      if not bEn then
257        Result := Result + QM + W[i]
258      else
259        Result := Result + W[i];
260
261      if I = Len then
262        Result := Result + QM;
263      bEn := true;
264    end;
265  end;
266end;
267
268// ??????? n ???????
269function iGetDelimiterIndex(const AStr: string; n: integer): integer;
270var
271  Count, I: integer;
272begin
273  Result := 0;
274  Count := 0;
275  for I := 1 to length(AStr) do
276  begin
277    if AStr[I] = SDELI then
278    begin
279      Count := Count + 1;
280      if (n = Count) then
281      begin
282        Result := i;
283      end;
284    end;
285  end;
286end;
287
288// ??????? m ?????? n ?????????(m<n)
289function GetDelimiterStr(const AStr: string; m: integer; n: integer): string;
290var
291  iFirstDeli, iSecondDeli: integer;
292begin
293  if m >= n then
294    Exit;
295  iFirstDeli := iGetDelimiterIndex(AStr, m);
296  iSecondDeli := iGetDelimiterIndex(AStr, n);
297  result := copy(AStr, iFirstDeli + 1, iSecondDeli - iFirstDeli - 1);
298end;
299
300// ???????
301function GetDelimiterCount(const AStr, ADeli:string):integer;
302var
303  I: integer;
304begin
305  Result := 0;
306  for I := Length(AStr) downto 1 do
307  begin
308    if ADeli = AStr[I] then
309    begin
310      Inc(Result);
311    end;
312  end;
313end;
314
315// ?? string case
316function StringToCaseSelect(Selector : string; CaseList: array of string): Integer;
317var
318  cnt: integer;
319begin
320   Result := -1;
321   for cnt := 0 to Length(CaseList)-1 do
322   begin
323     if CompareText( Selector, CaseList[cnt]) = 0 then
324     begin
325       Result := cnt;
326       Break;
327     end;
328   end;
329end;
330
331// ???????????????
332function IsExistStr(const AStr: string; var AStrList: TStringArray): Boolean;
333var
334  cnt: Integer;
335begin
336  Result := false;
337  for cnt := Low(AStrList) to High(AStrList) do
338  begin
339    if CompareText(AStr, AStrList[cnt]) = 0 then
340    begin
341      Result := true;
342      Break;
343    end;
344  end;
345end;
346
347// ????????????? Delphi ???
348function IsInteger(const AStr: string): Boolean;
349begin
350  Result := IsExistStr(AStr, SqlInteger);
351end;
352
353// ????????????? Delphi ????
354function IsFloat(const AStr: string): Boolean;
355begin
356  Result := IsExistStr(AStr, SqlFloat);
357end;
358
359// ????????????? Delphi ????
360function IsString(const AStr: string): Boolean;
361begin
362  Result := IsExistStr(AStr, SqlString);
363end;
364
365// ???? case string
366function ParseSqlDataType(const ADataType: string): Integer;
367begin
368  Result := 0;
369  if IsInteger(ADataType) then
370    Result := 1
371  else if IsFloat(ADataType) then
372    Result := 2
373  else if IsString(ADataType) then
374    Result := 3;
375end;
376
377//------------------------------------------------------------------------------
378// ????????
379//------------------------------------------------------------------------------
380
381// ???? TLabel
382procedure CEGenTLabel(ANo, ALeft, ATop: Integer; const ACaption: string);
383const
384  CeTLabel = SP4 + 'lbl%d: TStaticText;';
385  CeTLabelDfm =
386      '  object lbl%d: TStaticText' + SDELI
387    + '    Left = %d ' + SDELI
388    + '    Top = %d ' + SDELI
389    + '    Width = 120 ' + SDELI
390    + '    AutoSize = False ' + SDELI
391    + '    BorderStyle = sbsSingle ' + SDELI
392    + '    Color = clBtnFace ' + SDELI
393    + '    Alignment = taCenter ' + SDELI
394    + '    Height = 25 ' + SDELI
395    + '    Caption = %s ' + SDELI
396    + '  end ' + SDELI;
397var
398  sCeTLabel: string;
399  sCeTLabelDfm: string;
400  Count: Integer;
401  I: Integer;
402begin
403  sCeTLabel := Format(CeTLabel, [ANo]);
404  AddControl.Add(sCeTLabel);
405
406  sCeTLabelDfm := Format(CeTLabelDfm, [ANo, ALeft, ATop, StrToDfmFmt(ACaption)]);
407  Count := GetDelimiterCount(sCeTLabelDfm, SDELI);
408  for I := 1 to Count do
409  begin
410    AddControlDfm.Add(GetDelimiterStr(sCeTLabelDfm, I-1, I));
411  end;
412end;
413
414// ???? TEdit
415procedure CEGenTEdit(ALeft, ATop: Integer; const AEdtName: string);
416const
417  CeTEdit = SP4 + 'edt%s: TMaskEdit;';
418  CeTEditDfm =
419      '  object edt%s: TMaskEdit' + SDELI
420    + '    Left = %d ' + SDELI
421    + '    Top = %d ' + SDELI
422    + '    AutoSize = False ' + SDELI
423    + '    Width = 121 ' + SDELI
424    + '    Height = 25 ' + SDELI
425    + '    Ctl3D = false ' + SDELI
426    + '    BorderStyle = bsSingle ' + SDELI
427    + '    Text = ''edt%s'' ' + SDELI
428    + '  end ' + SDELI;
429var
430  sCeTEdit: string;
431  sCeTEditDfm: string;
432  Count: Integer;
433  I: Integer;
434begin
435  sCeTEdit := Format(CeTEdit, [AEdtName]);
436  AddControl.Add(sCeTEdit);
437
438  sCeTEditDfm := Format(CeTEditDfm, [AEdtName, ALeft, ATop, AEdtName]);
439  Count := GetDelimiterCount(sCeTEditDfm, SDELI);
440  for I := 1 to Count do
441  begin
442    AddControlDfm.Add(GetDelimiterStr(sCeTEditDfm, I-1, I));
443  end;
444end;
445
446// ???? TClientdataset
447procedure CEGenTClientDataSet( const ATableName,AColumnName,AChineseName,AType,ASize: string);
448const
449  CeTEdit = SP4 + 'object cds_table: TClientDataSet ' + SDELI
450                +' Aggregates = <> ' + SDELI
451                +' Params = <> ' + SDELI
452                +' Left = 144 ' + SDELI
453                +' Top = 256 ' + SDELI ;
454  CeTEditDfm =
455      '   object %s%s: %s' + SDELI
456    + '       DisplayLabel = %s ' + SDELI
457    + '       DisplayWidth = 20 ' + SDELI
458    + '       FieldName = ''%s'' ' + SDELI
459    + '       Size = %s ' + SDELI
460    + '   end '  + SDELI;
461var
462  sCeTEdit: string;
463  sCeTEditDfm: string;
464  sType:String;
465  Count: Integer;
466  I: Integer;
467begin
468   //TWideStringField???
469   if AddCdsControl.Count=0 then
470   begin
471    //  sCeTEdit:=format(CeTedit,[aTableName]  );
472      Count := GetDelimiterCount(sCeTEdit, SDELI);
473      for I := 1 to Count do
474      begin
475         AddCdsControl.Add(GetDelimiterStr(sCeTEdit, I-1, I));
476      end;
477   end;
478
479  // if upperCase(aType)='C' then sType:='TWideStringField';
480   sType:='TWideStringField';
481   sCeTEditDfm:=format(CeTEditDfm,[aTableName,aColumnName,sType,StrToDfmFmt(AChineseName),AColumnName,aSize]);
482   Count := GetDelimiterCount(sCeTEditDfm, SDELI);
483   for I := 1 to Count do
484    begin
485         AddCdsControl.Add(GetDelimiterStr(sCeTEditDfm, I-1, I));
486   end;
487
488   AddCdsFieldControl.Add(aTableName+aColumnName+':TWideStringField; ' );
489
490
491end;
492
493
494// ???? TButton
495procedure CEGenTButton(ALeft, ATop: Integer; const AName, ACaption: string);
496const
497  CeTx = SP4 + 'btn%s: TButton;';
498  CeTxDfm =
499      '  object btn%s: TButton' + SDELI
500    + '    Left = %d ' + SDELI
501    + '    Top = %d ' + SDELI
502    + '    Width = 75 ' + SDELI
503    + '    Height = 25 ' + SDELI
504    + '    Caption = %s ' + SDELI
505    + '  end ' + SDELI;
506var
507  sCeTx: string;
508  sCeTxDfm: string;
509  Count: Integer;
510  I: Integer;
511begin
512  sCeTx := Format(CeTx, [AName]);
513  AddControl.Add(sCeTx);
514
515  sCeTxDfm := Format(CeTxDfm, [AName, ALeft, ATop, StrToDfmFmt(ACaption)]);
516  Count := GetDelimiterCount(sCeTxDfm, SDELI);
517  for I := 1 to Count do
518  begin
519    AddControlDfm.Add(GetDelimiterStr(sCeTxDfm, I-1, I));
520  end;
521end;
522
523// ???? TADOConnection
524procedure CEGenTADOConnection(ALeft, ATop: Integer; const AName: string);
525const
526  CeTx = SP4 + 'con%s: TADOConnection;';
527  CeTxDfm =
528      '  object con%s: TADOConnection' + SDELI
529    + '    Left = %d ' + SDELI
530    + '    Top = %d ' + SDELI
531    + '  end ' + SDELI;
532var
533  sCeTx: string;
534  sCeTxDfm: string;
535  Count: Integer;
536  I: Integer;
537begin
538  sCeTx := Format(CeTx, [AName]);
539  AddControl.Add(sCeTx);
540
541  sCeTxDfm := Format(CeTxDfm, [AName, ALeft, ATop]);
542  Count := GetDelimiterCount(sCeTxDfm, SDELI);
543  for I := 1 to Count do
544  begin
545    AddControlDfm.Add(GetDelimiterStr(sCeTxDfm, I-1, I));
546  end;
547end;
548
549// ???? TADOQuery
550procedure CEGenTADOQuery(ALeft, ATop: Integer; const AName, AAdoCon: string);
551const
552  CeTx = SP4 + 'qry%s: TADOQuery;';
553  CeTxDfm =
554      '  object qry%s: TADOQuery' + SDELI
555    + '    Connection = %s' + SDELI
556    + '    Parameters = <> ' + SDELI
557    + '    Left = %d ' + SDELI
558    + '    Top = %d ' + SDELI
559    + '  end ' + SDELI;
560var
561  sCeTx: string;
562  sCeTxDfm: string;
563  Count: Integer;
564  I: Integer;
565begin
566  sCeTx := Format(CeTx, [AName]);
567  AddControl.Add(sCeTx);
568
569  sCeTxDfm := Format(CeTxDfm, [AName,AAdoCon, ALeft, ATop]);
570  AddControlDfm.Add('');
571  Count := GetDelimiterCount(sCeTxDfm, SDELI);
572  for I := 1 to Count do
573  begin
574    AddControlDfm.Add(GetDelimiterStr(sCeTxDfm, I-1, I));
575  end;
576end;
577
578// ?????????, ???????
579// ??????: ??????????
580procedure CEGenShowTableRec(const AFormName, ATableName, AConQry: string; var ColumnsTypes: string);
581const
582  CeShowTableHead = 'procedure %sShow%s(const SID: string);';
583  CeShowTable =
584'const' + SDELI +
585'  cnSql_Show%s = ''select top 1 * from %s where %s = %s; ''; ' + SDELI +// ??????????
586'var' + SDELI +
587'  ExeSql: string; ' + SDELI +
588'begin' + SDELI +
589'  ExeSql := Format(cnSql_Show%s, [SID]);' + SDELI +
590'  with %s do' + SDELI +
591'  begin' + SDELI +
592'    close;' + SDELI +
593'    sql.clear;' + SDELI +
594'    sql.add(ExeSql);' + SDELI +
595'    Open;' + SDELI +
596'    if RecordCount=1 then' + SDELI +
597'    begin' + SDELI +
598'%s' + //SDELI +
599'    end;' + SDELI +
600'  end;' + SDELI +
601'end;' + SDELI ;
602
603  // edt%s.Text :=  FieldByName(''%s'').AsString;
604  CeEdit = 'edt%s';
605  CeEditField =  SP6 + '%s.Text :=  FieldByName(''%s'').AsString; // %s' + SDELI;
606var
607  sCeShowTableHeadPriv: string;
608  sCeShowTableHeadForm: string;
609  sCeShowTable: string;
610  sColumnName: string;
611  sColumnChineseName:String;
612  sTableName:String;
613  sColumnSIze:String;
614  sTypeName: string;
615  sCeEdit: string;
616  sCeEditField: string;
617  Count: Integer;
618  I: Integer;
619  J: Integer;
620begin
621  // ???
622//  sCeShowTableHeadPriv := SP4 + Format(CeShowTableHead, ['', ATableName]);
623//  AddPrivateFunc.Add(sCeShowTableHeadPriv);
624//  sCeShowTableHeadForm := Format(CeShowTableHead, ['T' + AFormName + '.', ATableName]);
625//  AddFormFunc.Add(sCeShowTableHeadForm);
626
627  // ???
628  Count := GetDelimiterCount(ColumnsTypes, SDELI);
629  I := 0;
630  J := 0;
631  while I < Count do
632  begin
633    Inc(J);
634    sColumnName := GetDelimiterStr(ColumnsTypes, I, I + 1);
635    Inc(I);
636    sTypeName := GetDelimiterStr(ColumnsTypes, I, I + 1);
637    Inc(I);     //quanj
638    sColumnChineseName := GetDelimiterStr(ColumnsTypes, I, I + 1);  //quanj
639    if    sColumnChineseName='' then sColumnChineseName:=  sColumnName;
640    Inc(I);
641    sTableName := GetDelimiterStr(ColumnsTypes, I, I + 1);  //quanj
642    Inc(I);
643    sColumnSIze := GetDelimiterStr(ColumnsTypes, I, I + 1);  //quanj
644    Inc(I);
645    sCeEdit := Format(CeEdit, [sColumnName]);
646    sCeEditField := sCeEditField + Format(CeEditField, [sCeEdit, sColumnName, sTypeName]);
647
648    CEGenTLabel(J, 80, J * 24, sColumnChineseName); // ?? TLabel/TEdit
649    CEGenTEdit(180, J * 24, sColumnName);
650
651  end;
652
653//  sCeShowTable := Format(CeShowTable, [ATableName,ATableName, sColumnName, '''''%s''''',
654//    ATableName, AConQry, sCeEditField]);
655//  Count := GetDelimiterCount(sCeShowTable, SDELI);
656//  for I := 1 to Count do
657//  begin
658//    AddFormFunc.Add(GetDelimiterStr(sCeShowTable, I-1, I));
659//  end;
660//  if Count > 0 then
661//    AddFormFunc.Add('');
662end;
663
664// ???????????
665procedure CEGenDelTableRec(const AFormName, ATableName, AColumnName, AConQry, AAdoCon: string);
666const
667  CeProcHead = 'function %sDel%s(const SID: string): Boolean;';
668  CeProcBody =
669'const' + SDELI +
670'  cnSql_Del%s = ''delete  from %s where %s = %s; ''; ' + SDELI +// ??????????
671'var' + SDELI +
672'  ExeSql: string; ' + SDELI +
673'begin' + SDELI +
674'  Result := true; ' + SDELI +
675'  ExeSql := Format(cnSql_Del%s, [SID]);' + SDELI +
676'  try' + SDELI +
677'    %s.BeginTrans; ' + SDELI +
678'    with %s do' + SDELI +
679'    begin' + SDELI +
680'      close;' + SDELI +
681'      sql.clear;' + SDELI +
682'      sql.add(ExeSql);' + SDELI +
683'      ExecSql;' + SDELI +
684'    end;' + SDELI +
685'    %s.CommitTrans; ' + SDELI +
686'  except ' + SDELI +
687'    %s.RollbackTrans; ' + SDELI +
688'    Result := false; ' + SDELI +
689'  end; ' + SDELI +
690'end;' + SDELI ;
691
692var
693  sCeProcHeadPriv: string;
694  sCeProcHeadForm: string;
695  sCeProcBody: string;
696  Count: Integer;
697  I: Integer;
698begin
699  // ???
700  sCeProcHeadPriv := SP4 + Format(CeProcHead, ['', ATableName]);
701  AddPrivateFunc.Add(sCeProcHeadPriv);
702  sCeProcHeadForm := Format(CeProcHead, ['T' + AFormName + '.', ATableName]);
703  AddFormFunc.Add(sCeProcHeadForm);
704
705  // ???
706  sCeProcBody := Format(CeProcBody, [ATableName,ATableName, AColumnName, '''''%s''''',
707    ATableName, AAdoCon, AConQry, AAdoCon, AAdoCon]);
708  Count := GetDelimiterCount(sCeProcBody, SDELI);
709  for I := 1 to Count do
710  begin
711    AddFormFunc.Add(GetDelimiterStr(sCeProcBody, I-1, I));
712  end;
713  if Count > 0 then
714    AddFormFunc.Add('');
715end;
716
717// ???????????
718procedure CEGenInsertTableRec(const AFormName, ATableName, AConQry, AAdoCon: string; var ColumnsTypes: string);
719const
720  CeProcHead = 'function %sInsert%s(%s): Boolean;';
721  CeProcBody =
722'const' + SDELI +
723'  cnSql_Insert%s = ''insert into %s(%s) values(%s); ''; ' + SDELI +// ??????????
724'var' + SDELI +
725'  ExeSql: string; ' + SDELI +
726'begin' + SDELI +
727'  Result := true; ' + SDELI +
728'  ExeSql := Format(cnSql_Insert%s, [%s]);' + SDELI +
729'  try' + SDELI +
730'    %s.BeginTrans; ' + SDELI +
731'    with %s do' + SDELI +
732'    begin' + SDELI +
733'      close;' + SDELI +
734'      sql.clear;' + SDELI +
735'      sql.add(ExeSql);' + SDELI +
736'      ExecSql;' + SDELI +
737'    end;' + SDELI +
738'    %s.CommitTrans; ' + SDELI +
739'  except ' + SDELI +
740'    %s.RollbackTrans; ' + SDELI +
741'    Result := false; ' + SDELI +
742'  end; ' + SDELI +
743'end;' + SDELI ;
744
745var
746  sCeProcHeadPriv: string;
747  sCeProcHeadForm: string;
748  sCeProcBody: string;
749  
750  sColumnName: string;
751  sTypeName: string;
752
753  sFormParams: string; // ????
754  sColumns: string; // ?????
755  sColumnsValue: string; // ??
756
757  Count: Integer;
758  I: Integer;
759begin
760  // ???
761  Count := GetDelimiterCount(ColumnsTypes, SDELI);
762  I := 0;
763  while I < Count do
764  begin
765    sColumnName := GetDelimiterStr(ColumnsTypes, I, I + 1);
766    Inc(I);
767    sTypeName := GetDelimiterStr(ColumnsTypes, I, I + 1);
768    Inc(I);
769
770    sColumns := sColumns + sColumnName + ', ';
771    case ParseSqlDataType(sTypeName) of
772      1:
773        begin
774          sFormParams := sFormParams + sColumnName + ': Integer; ';
775          sColumnsValue := sColumnsValue + cnFmtInt + ', ';
776        end;
777      2:
778        begin
779          sFormParams := sFormParams + sColumnName + ': Single; ';
780          sColumnsValue := sColumnsValue + cnFmtFlt + ', ';
781        end;
782      3:
783        begin
784          sFormParams := sFormParams + sColumnName + ': string; ';
785          sColumnsValue := sColumnsValue + cnFmtStr + ', ';
786        end;
787      else
788      begin
789        sFormParams := sFormParams + sColumnName + ': string; ';
790        sColumnsValue := sColumnsValue + cnFmtStr + ', ';
791      end;
792    end;
793    
794    if I = Count then
795    begin
796      sColumns := LeftStr(sColumns, Length(sColumns) - 2);
797      sColumnsValue := LeftStr(sColumnsValue, Length(sColumnsValue) - 2);
798
799      sFormParams := LeftStr(sFormParams, Length(sFormParams) - 2);
800      sFormParams := 'const ' + sFormParams;
801    end;
802  end;
803
804  // ???
805  sCeProcHeadPriv := SP4 + Format(CeProcHead, ['', ATableName, sFormParams]);
806  AddPrivateFunc.Add(sCeProcHeadPriv);
807  sCeProcHeadForm := Format(CeProcHead, ['T' + AFormName + '.', ATableName, sFormParams]);
808  AddFormFunc.Add(sCeProcHeadForm);
809  
810  // ???
811  sCeProcBody := Format(CeProcBody, [ATableName, ATableName, sColumns, sColumnsValue, 
812    ATableName, sColumns, AAdoCon, AConQry, AAdoCon, AAdoCon]);
813  Count := GetDelimiterCount(sCeProcBody, SDELI);
814  for I := 1 to Count do
815  begin
816    AddFormFunc.Add(GetDelimiterStr(sCeProcBody, I-1, I));
817  end;
818  if Count > 0 then
819    AddFormFunc.Add('');
820end;
821
822// ???????????
823procedure CEGenUpdateTableRec(const AFormName, ATableName,AColumnName, AConQry, AAdoCon: string; var ColumnsTypes: string);
824const
825  CeProcHead = 'function %sUpdate%s(const SID: string; %s): Boolean;';
826  CeProcBody =
827'const' + SDELI +
828'  cnSql_Update%s = ''update %s set %s where %s = %s ; ''; ' + SDELI +// ??????????
829'var' + SDELI +
830'  ExeSql: string; ' + SDELI +
831'begin' + SDELI +
832'  Result := true; ' + SDELI +
833'  ExeSql := Format(cnSql_Update%s, [%s]);' + SDELI +
834'  try' + SDELI +
835'    %s.BeginTrans; ' + SDELI +
836'    with %s do' + SDELI +
837'    begin' + SDELI +
838'      close;' + SDELI +
839'      sql.clear;' + SDELI +
840'      sql.add(ExeSql);' + SDELI +
841'      ExecSql;' + SDELI +
842'    end;' + SDELI +
843'    %s.CommitTrans; ' + SDELI +
844'  except ' + SDELI +
845'    %s.RollbackTrans; ' + SDELI +
846'    Result := false; ' + SDELI +
847'  end; ' + SDELI +
848'end;' + SDELI ;
849
850var
851  sCeProcHeadPriv: string;
852  sCeProcHeadForm: string;
853  sCeProcBody: string;
854  sColumnName: string;
855  sTypeName: string;
856  sFormParams: string; // ????
857  sColumns: string; // ?????
858  sColumnsValue: string; // ??
859  Count: Integer;
860  I: Integer;
861begin
862  // ???
863  Count := GetDelimiterCount(ColumnsTypes, SDELI);
864  I := 0;
865  while I < Count do
866  begin
867    sColumnName := GetDelimiterStr(ColumnsTypes, I, I + 1);
868    Inc(I);
869    sTypeName := GetDelimiterStr(ColumnsTypes, I, I + 1);
870    Inc(I);
871
872    sColumns := sColumns + sColumnName + ', ';
873    case ParseSqlDataType(sTypeName) of
874      1:
875        begin
876          sFormParams := sFormParams + sColumnName + ': Integer; ';
877          sColumnsValue := sColumnsValue + sColumnName + '=' + cnFmtInt + ', ';
878        end;
879      2:
880        begin
881          sFormParams := sFormParams + sColumnName + ': Single; ';
882          sColumnsValue := sColumnsValue + sColumnName + '=' + cnFmtFlt + ', ';
883        end;
884      3:
885        begin
886          sFormParams := sFormParams + sColumnName + ': string; ';
887          sColumnsValue := sColumnsValue + sColumnName + '=' + cnFmtStr + ', ';
888        end;
889      else
890      begin
891        sFormParams := sFormParams + sColumnName + ': string; ';
892        sColumnsValue := sColumnsValue + sColumnName + '=' + cnFmtStr + ', ';
893      end;
894    end;
895    
896    if I = Count then
897    begin
898      sColumns := sColumns + 'SID, ';
899      sColumns := LeftStr(sColumns, Length(sColumns) - 2);
900      sColumnsValue := LeftStr(sColumnsValue, Length(sColumnsValue) - 2);
901
902      sFormParams := LeftStr(sFormParams, Length(sFormParams) - 2);
903      sFormParams := 'const ' + sFormParams;
904    end;
905  end;
906
907  // ???
908  sCeProcHeadPriv := SP4 + Format(CeProcHead, ['', ATableName, sFormParams]);
909  AddPrivateFunc.Add(sCeProcHeadPriv);
910  sCeProcHeadForm := Format(CeProcHead, ['T' + AFormName + '.', ATableName, sFormParams]);
911  AddFormFunc.Add(sCeProcHeadForm);
912  
913  // ???
914  sCeProcBody := Format(CeProcBody, [ATableName, ATableName, sColumnsValue, AColumnName, cnFmtStr,
915    ATableName, sColumns, AAdoCon, AConQry, AAdoCon, AAdoCon]);
916  Count := GetDelimiterCount(sCeProcBody, SDELI);
917  for I := 1 to Count do
918  begin
919    AddFormFunc.Add(GetDelimiterStr(sCeProcBody, I-1, I));
920  end;
921  if Count > 0 then
922    AddFormFunc.Add('');
923end;
924
925initialization
926  SetLength(SqlInteger, 5);
927  SetLength(SqlFloat, 2);
928  SetLength(SqlString, 8);
929
930  SqlInteger[0] := 'tinyint';
931  SqlInteger[1] := 'smallint';
932  SqlInteger[2] := 'int';
933  SqlInteger[3] := 'bigint';
934  SqlInteger[4] := 'decimal';
935
936  SqlFloat[0] := 'float';
937  SqlFloat[1] := 'real';
938
939  SqlString[0] := 'char';
940  SqlString[1] := 'nchar';
941  SqlString[2] := 'varchar';
942  SqlString[3] := 'nvarchar';
943  SqlString[4] := 'text';
944  SqlString[5] := 'smalldatetime';
945  SqlString[6] := 'datetime';
946  SqlString[7] := 'timestamp';
947
948end.
949
950