home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / DBUTILS.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  25KB  |  844 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBUtils;
  11.  
  12. {$I RX.INC}
  13. {$W-,R-,B-,N+,P+}
  14.  
  15. interface
  16.  
  17. uses {$IFDEF WIN32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  18.   Classes, SysUtils, DB, {$IFNDEF RX_D3} DBTables, {$ENDIF} IniFiles;
  19.  
  20. type
  21.  
  22. { TLocateObject }
  23.  
  24.   TLocateObject = class(TObject)
  25.   private
  26.     FDataSet: TDataSet;
  27.     FLookupField: TField;
  28.     FLookupValue: string;
  29.     FLookupExact, FCaseSensitive: Boolean;
  30.     FBookmark: TBookmark;
  31.     FIndexSwitch: Boolean;
  32.     procedure SetDataSet(Value: TDataSet);
  33.   protected
  34.     function MatchesLookup(Field: TField): Boolean;
  35.     procedure CheckFieldType(Field: TField); virtual;
  36.     procedure ActiveChanged; virtual;
  37.     function LocateFilter: Boolean; virtual;
  38.     function LocateKey: Boolean; virtual;
  39.     function LocateFull: Boolean; virtual;
  40.     function UseKey: Boolean; virtual;
  41.     function FilterApplicable: Boolean; virtual;
  42.     property LookupField: TField read FLookupField;
  43.     property LookupValue: string read FLookupValue;
  44.     property LookupExact: Boolean read FLookupExact;
  45.     property CaseSensitive: Boolean read FCaseSensitive;
  46.     property Bookmark: TBookmark read FBookmark write FBookmark;
  47.   public
  48.     function Locate(const KeyField, KeyValue: string; Exact,
  49.       CaseSensitive: Boolean): Boolean;
  50.     property DataSet: TDataSet read FDataSet write SetDataSet;
  51.     property IndexSwitch: Boolean read FIndexSwitch write FIndexSwitch;
  52.   end;
  53.  
  54. type
  55.   TCreateLocateObject = function: TLocateObject;
  56. const
  57.   CreateLocateObject: TCreateLocateObject = nil;
  58. function CreateLocate(DataSet: TDataSet): TLocateObject;
  59.  
  60. { Utility routines }
  61.  
  62. function IsDataSetEmpty(DataSet: TDataSet): Boolean;
  63. procedure RefreshQuery(Query: TDataSet);
  64. function DataSetSortedSearch(DataSet: TDataSet; const Value,
  65.   FieldName: string; CaseInsensitive: Boolean): Boolean;
  66. function DataSetSectionName(DataSet: TDataSet): string;
  67. procedure InternalSaveFields(DataSet: TDataSet; IniFile: TObject;
  68.   const Section: string);
  69. procedure InternalRestoreFields(DataSet: TDataSet; IniFile: TObject;
  70.   const Section: string; RestoreVisible: Boolean);
  71. {$IFDEF WIN32}
  72. function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  73.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  74. procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
  75. procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
  76.   RestoreVisible: Boolean);
  77. {$ENDIF WIN32}
  78. procedure SaveFields(DataSet: TDataSet; IniFile: TIniFile);
  79. procedure RestoreFields(DataSet: TDataSet; IniFile: TIniFile;
  80.   RestoreVisible: Boolean);
  81. procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
  82. function ConfirmDelete: Boolean;
  83. procedure ConfirmDataSetCancel(DataSet: TDataSet);
  84. procedure CheckRequiredField(Field: TField);
  85. procedure CheckRequiredFields(const Fields: array of TField);
  86.  
  87. { SQL expressions }
  88.  
  89. function DateToSQL(Value: TDateTime): string;
  90. function FormatSQLDateRange(Date1, Date2: TDateTime;
  91.   const FieldName: string): string;
  92. function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
  93.   const FieldName: string): string;
  94. function FormatSQLNumericRange(const FieldName: string;
  95.   LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
  96. function StrMaskSQL(const Value: string): string;
  97. function FormatSQLCondition(const FieldName, Operator, Value: string;
  98.   FieldType: TFieldType; Exact: Boolean): string;
  99. function FormatAnsiSQLCondition(const FieldName, Operator, Value: string;
  100.   FieldType: TFieldType; Exact: Boolean): string;
  101.  
  102. const
  103.   TrueExpr = '0=0';
  104.  
  105. const
  106.   { Server Date formats}
  107.   sdfStandard16 = '''"''mm''/''dd''/''yyyy''"'''; {"mm/dd/yyyy"}
  108.   sdfStandard32 = '''''''dd/mm/yyyy''''''';       {'dd/mm/yyyy'}
  109.   sdfOracle     = '"TO_DATE(''"dd/mm/yyyy"'', ''DD/MM/YYYY'')"';
  110.   sdfInterbase  = '"CAST(''"mm"/"dd"/"yyyy"'' AS DATE)"';
  111.   sdfMSSQL      = '"CONVERT(datetime, ''"mm"/"dd"/"yyyy"'', 103)"';
  112.  
  113. const
  114.   ServerDateFmt: string[50] = sdfStandard16;
  115.  
  116. {$IFNDEF WIN32}
  117. type
  118.   TBlobType = ftBlob..ftGraphic;
  119. {$ENDIF}
  120.  
  121. const
  122. {$IFNDEF RX_D4}
  123.   {$IFDEF WIN32}
  124.   ftBlobTypes = [ftBlob..ftTypedBinary];
  125.   {$ELSE}
  126.   ftBlobTypes = [ftBlob..ftGraphic];
  127.   {$ENDIF}
  128. {$ELSE}
  129.   ftBlobTypes = [Low(TBlobType)..High(TBlobType)];
  130. {$ENDIF RX_D3}
  131. {$IFDEF RX_V110} {$NODEFINE ftBlobTypes} {$ENDIF}
  132.  
  133. {$IFNDEF RX_D4}
  134.   ftNonTextTypes = [ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic
  135.     {$IFDEF WIN32}, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary
  136.     {$IFDEF RX_D3}, ftCursor {$ENDIF} {$ENDIF}];
  137.   {$IFDEF VER110} { C++ Builder 3 or higher }
  138.   {$NODEFINE ftNonTextTypes}
  139.   (*$HPPEMIT 'namespace Dbutils'*)
  140.   (*$HPPEMIT '{'*)
  141.   (*$HPPEMIT '#define ftNonTextTypes (System::Set<TFieldType, ftUnknown, ftCursor> () \'*)
  142.   (*$HPPEMIT '        << ftBytes << ftVarBytes << ftBlob << ftMemo << ftGraphic \'*)
  143.   (*$HPPEMIT '        << ftFmtMemo << ftParadoxOle << ftDBaseOle << ftTypedBinary << ftCursor )'*)
  144.   (*$HPPEMIT '}'*)
  145.   {$ENDIF}
  146. type
  147.   Largeint = Longint;
  148.   {$IFDEF VER110} {$NODEFINE Largeint} {$ENDIF}
  149. {$ENDIF RX_D4}
  150.  
  151. {$IFDEF RX_D3}
  152. procedure _DBError(const Msg: string);
  153. {$ELSE}
  154. procedure _DBError(Ident: Word);
  155. {$ENDIF}
  156.  
  157. implementation
  158.  
  159. uses Forms, Controls, Dialogs, Consts, DBConsts, RXDConst, VCLUtils, FileUtil,
  160.   AppUtils, rxStrUtils, MaxMin, {$IFNDEF RX_D3} BdeUtils, {$ENDIF}
  161.   {$IFNDEF WIN32} Str16, {$ENDIF} DateUtil;
  162.  
  163. { Utility routines }
  164.  
  165. {$IFDEF RX_D3}
  166. procedure _DBError(const Msg: string);
  167. begin
  168.   DatabaseError(Msg);
  169. {$ELSE}
  170. procedure _DBError(Ident: Word);
  171. begin
  172.   DBError(Ident);
  173. {$ENDIF}
  174. end;
  175.  
  176. function ConfirmDelete: Boolean;
  177. begin
  178.   Screen.Cursor := crDefault;
  179.   Result := MessageDlg(ResStr(SDeleteRecordQuestion), mtConfirmation,
  180.     [mbYes, mbNo], 0) = mrYes;
  181. end;
  182.  
  183. procedure ConfirmDataSetCancel(DataSet: TDataSet);
  184. begin
  185.   if DataSet.State in [dsEdit, dsInsert] then begin
  186.     DataSet.UpdateRecord;
  187.     if DataSet.Modified then begin
  188.       case MessageDlg(LoadStr(SConfirmSave), mtConfirmation, mbYesNoCancel, 0) of
  189.         mrYes: DataSet.Post;
  190.         mrNo: DataSet.Cancel;
  191.         else SysUtils.Abort;
  192.       end;
  193.     end
  194.     else DataSet.Cancel;
  195.   end;
  196. end;
  197.  
  198. {$IFDEF RX_D3}
  199. function SetToBookmark(ADataSet: TDataSet; ABookmark: TBookmark): Boolean;
  200. begin
  201.   Result := False;
  202.   with ADataSet do
  203.     if Active and (ABookmark <> nil) and not (Bof and Eof) and
  204.       BookmarkValid(ABookmark) then
  205.     try
  206.       ADataSet.GotoBookmark(ABookmark);
  207.       Result := True;
  208.     except
  209.     end;
  210. end;
  211. {$ENDIF}
  212.  
  213. { Refresh Query procedure }
  214.  
  215. procedure RefreshQuery(Query: TDataSet);
  216. var
  217.   BookMk: TBookmark;
  218. begin
  219.   with Query do begin
  220.     DisableControls;
  221.     try
  222.       if Active then BookMk := GetBookmark else BookMk := nil;
  223.       try
  224.         Close;
  225.         Open;
  226. {$IFDEF RX_D3}
  227.         SetToBookmark(Query, BookMk);
  228. {$ELSE}
  229.         if Query is TDBDataSet then SetToBookmark(Query, BookMk);
  230. {$ENDIF}
  231.       finally
  232.         if BookMk <> nil then FreeBookmark(BookMk);
  233.       end;
  234.     finally
  235.       EnableControls;
  236.     end;
  237.   end;
  238. end;
  239.  
  240. { TLocateObject }
  241.  
  242. procedure TLocateObject.SetDataSet(Value: TDataSet);
  243. begin
  244.   ActiveChanged;
  245.   FDataSet := Value;
  246. end;
  247.  
  248. function TLocateObject.LocateFull: Boolean;
  249. begin
  250.   Result := False;
  251.   with DataSet do begin
  252.     First;
  253.     while not EOF do begin
  254.       if MatchesLookup(FLookupField) then begin
  255.         Result := True;
  256.         Break;
  257.       end;
  258.       Next;
  259.     end;
  260.   end;
  261. end;
  262.  
  263. function TLocateObject.LocateKey: Boolean;
  264. begin
  265.   Result := False;
  266. end;
  267.  
  268. function TLocateObject.FilterApplicable: Boolean;
  269. begin
  270. {$IFDEF RX_D3}
  271.   Result := FLookupField.FieldKind in [fkData, fkInternalCalc];
  272. {$ELSE}
  273.   Result := ({$IFDEF WIN32} FLookupField.FieldKind = fkData {$ELSE}
  274.     not FLookupField.Calculated {$ENDIF}) and IsFilterApplicable(DataSet);
  275. {$ENDIF}
  276. end;
  277.  
  278. function TLocateObject.LocateFilter: Boolean;
  279. {$IFDEF WIN32}
  280. var
  281.   SaveCursor: TCursor;
  282.   Options: TLocateOptions;
  283.   Value: Variant;
  284. begin
  285.   SaveCursor := Screen.Cursor;
  286.   Screen.Cursor := crHourGlass;
  287.   try
  288.     Options := [];
  289.     if not FCaseSensitive then Include(Options, loCaseInsensitive);
  290.     if not FLookupExact then Include(Options, loPartialKey);
  291.     if (FLookupValue = '') then VarClear(Value)
  292.     else Value := FLookupValue;
  293.     Result := DataSet.Locate(FLookupField.FieldName, Value, Options);
  294.   finally
  295.     Screen.Cursor := SaveCursor;
  296.   end;
  297. {$ELSE}
  298. begin
  299.   Result := False;
  300. {$ENDIF}
  301. end;
  302.  
  303. procedure TLocateObject.CheckFieldType(Field: TField);
  304. begin
  305. end;
  306.  
  307. function TLocateObject.Locate(const KeyField, KeyValue: string;
  308.   Exact, CaseSensitive: Boolean): Boolean;
  309. var
  310.   LookupKey: TField;
  311. begin
  312.   if DataSet = nil then begin
  313.     Result := False;
  314.     Exit;
  315.   end;
  316.   DataSet.CheckBrowseMode;
  317.   LookupKey := DataSet.FieldByName(KeyField);
  318.   DataSet.CursorPosChanged;
  319.   FLookupField := LookupKey;
  320.   FLookupValue := KeyValue;
  321.   FLookupExact := Exact;
  322.   FCaseSensitive := CaseSensitive;
  323.   if FLookupField.DataType <> ftString then begin
  324.     FCaseSensitive := True;
  325.     try
  326.       CheckFieldType(FLookupField);
  327.     except
  328.       Result := False;
  329.       Exit;
  330.     end;
  331.   end;
  332.   FBookmark := DataSet.GetBookmark;
  333.   try
  334.     DataSet.DisableControls;
  335.     try
  336.       Result := MatchesLookup(FLookupField);
  337.       if not Result then begin
  338.         if UseKey then Result := LocateKey
  339.         else begin
  340.           if FilterApplicable then Result := LocateFilter
  341.           else Result := LocateFull;
  342.         end;
  343.         if not Result then SetToBookmark(DataSet, FBookmark);
  344.       end;
  345.     finally
  346.       DataSet.EnableControls;
  347.     end;
  348.   finally
  349.     FLookupValue := EmptyStr;
  350.     FLookupField := nil;
  351.     DataSet.FreeBookmark(FBookmark);
  352.     FBookmark := nil;
  353.   end;
  354. end;
  355.  
  356. function TLocateObject.UseKey: Boolean;
  357. begin
  358.   Result := False;
  359. end;
  360.  
  361. procedure TLocateObject.ActiveChanged;
  362. begin
  363. end;
  364.  
  365. function TLocateObject.MatchesLookup(Field: TField): Boolean;
  366. var
  367.   Temp: string;
  368. begin
  369.   Temp := Field.AsString;
  370.   if not FLookupExact then
  371.     SetLength(Temp, Min(Length(FLookupValue), Length(Temp)));
  372.   if FCaseSensitive then Result := AnsiCompareStr(Temp, FLookupValue) = 0
  373.   else Result := AnsiCompareText(Temp, FLookupValue) = 0;
  374. end;
  375.  
  376. function CreateLocate(DataSet: TDataSet): TLocateObject;
  377. begin
  378.   if Assigned(CreateLocateObject) then Result := CreateLocateObject
  379.   else Result := TLocateObject.Create;
  380.   if (Result <> nil) and (DataSet <> nil) then
  381.     Result.DataSet := DataSet;
  382. end;
  383.  
  384. { DataSet locate routines }
  385.  
  386. {$IFDEF WIN32}
  387. function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  388.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  389. var
  390.   FieldCount: Integer;
  391.   Fields: TList;
  392.   Bookmark: TBookmarkStr;
  393.  
  394.   function CompareField(Field: TField; Value: Variant): Boolean;
  395.   var
  396.     S: string;
  397.   begin
  398.     if Field.DataType = ftString then begin
  399.       S := Field.AsString;
  400.       if (loPartialKey in Options) then
  401.         Delete(S, Length(Value) + 1, MaxInt);
  402.       if (loCaseInsensitive in Options) then
  403.         Result := AnsiCompareText(S, Value) = 0
  404.       else
  405.         Result := AnsiCompareStr(S, Value) = 0;
  406.     end
  407.     else Result := (Field.Value = Value);
  408.   end;
  409.  
  410.   function CompareRecord: Boolean;
  411.   var
  412.     I: Integer;
  413.   begin
  414.     if FieldCount = 1 then
  415.       Result := CompareField(TField(Fields.First), KeyValues)
  416.     else begin
  417.       Result := True;
  418.       for I := 0 to FieldCount - 1 do
  419.         Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
  420.     end;
  421.   end;
  422.  
  423. begin
  424.   Result := False;
  425.   with DataSet do begin
  426.     CheckBrowseMode;
  427.     if BOF and EOF then Exit;
  428.   end;
  429.   Fields := TList.Create;
  430.   try
  431.     DataSet.GetFieldList(Fields, KeyFields);
  432.     FieldCount := Fields.Count;
  433.     Result := CompareRecord;
  434.     if Result then Exit;
  435.     DataSet.DisableControls;
  436.     try
  437.       Bookmark := DataSet.Bookmark;
  438.       try
  439.         with DataSet do begin
  440.           First;
  441.           while not EOF do begin
  442.             Result := CompareRecord;
  443.             if Result then Break;
  444.             Next;
  445.           end;
  446.         end;
  447.       finally
  448.         if not Result {$IFDEF RX_D3} and
  449.           DataSet.BookmarkValid(PChar(Bookmark)) {$ENDIF} then
  450.           DataSet.Bookmark := Bookmark;
  451.       end;
  452.     finally
  453.       DataSet.EnableControls;
  454.     end;
  455.   finally
  456.     Fields.Free;
  457.   end;
  458. end;
  459. {$ENDIF}
  460.  
  461. { DataSetSortedSearch. Navigate on sorted DataSet routine. }
  462.  
  463. function DataSetSortedSearch(DataSet: TDataSet; const Value,
  464.   FieldName: string; CaseInsensitive: Boolean): Boolean;
  465. var
  466.   L, H, I: Longint;
  467.   CurrentPos: Longint;
  468.   CurrentValue: string;
  469.   BookMk: TBookmark;
  470.   Field: TField;
  471.  
  472.   function UpStr(const Value: string): string;
  473.   begin
  474.     if CaseInsensitive then Result := AnsiUpperCase(Value)
  475.     else Result := Value;
  476.   end;
  477.  
  478.   function GetCurrentStr: string;
  479.   begin
  480.     Result := Field.AsString;
  481.     if Length(Result) > Length(Value) then
  482.       SetLength(Result, Length(Value));
  483.     Result := UpStr(Result);
  484.   end;
  485.  
  486. begin
  487.   Result := False;
  488.   if DataSet = nil then Exit;
  489.   Field := DataSet.FindField(FieldName);
  490.   if Field = nil then Exit;
  491.   if Field.DataType = ftString then begin
  492.     DataSet.DisableControls;
  493.     BookMk := DataSet.GetBookmark;
  494.     try
  495.       L := 0;
  496.       DataSet.First;
  497.       CurrentPos := 0;
  498.       H := DataSet.RecordCount - 1;
  499.       if Value <> '' then begin
  500.         while L <= H do begin
  501.           I := (L + H) shr 1;
  502.           if I <> CurrentPos then DataSet.MoveBy(I - CurrentPos);
  503.           CurrentPos := I;
  504.           CurrentValue := GetCurrentStr;
  505.           if (UpStr(Value) > CurrentValue) then
  506.             L := I + 1
  507.           else begin
  508.             H := I - 1;
  509.             if (UpStr(Value) = CurrentValue) then Result := True;
  510.           end;
  511.         end; { while }
  512.         if Result then begin
  513.           if (L <> CurrentPos) then DataSet.MoveBy(L - CurrentPos);
  514.           while (L < DataSet.RecordCount) and
  515.             (UpStr(Value) <> GetCurrentStr) do
  516.           begin
  517.             Inc(L);
  518.             DataSet.MoveBy(1);
  519.           end;
  520.         end;
  521.       end
  522.       else Result := True;
  523.       if not Result then SetToBookmark(DataSet, BookMk);
  524.     finally
  525.       DataSet.FreeBookmark(BookMk);
  526.       DataSet.EnableControls;
  527.     end;
  528.   end
  529.   else
  530. {$IFDEF RX_D3}
  531.     DatabaseErrorFmt(SFieldTypeMismatch, [Field.DisplayName]);
  532. {$ELSE}
  533.     DBErrorFmt(SFieldTypeMismatch,
  534.       [Field.DisplayName{$IFNDEF WIN32}^{$ENDIF}]);
  535. {$ENDIF}
  536. end;
  537.  
  538. { Save and restore DataSet Fields layout }
  539.  
  540. function DataSetSectionName(DataSet: TDataSet): string;
  541. begin
  542.   with DataSet do
  543.     if (Owner <> nil) and (Owner is TCustomForm) then
  544.       Result := GetDefaultSection(Owner as TCustomForm)
  545.     else Result := Name;
  546. end;
  547.  
  548. function CheckSection(DataSet: TDataSet; const Section: string): string;
  549. begin
  550.   Result := Section;
  551.   if Result = '' then Result := DataSetSectionName(DataSet);
  552. end;
  553.  
  554. procedure InternalSaveFields(DataSet: TDataSet; IniFile: TObject;
  555.   const Section: string);
  556. var
  557.   I: Integer;
  558. begin
  559.   with DataSet do begin
  560.     for I := 0 to FieldCount - 1 do begin
  561.       IniWriteString(IniFile, CheckSection(DataSet, Section),
  562.         Name + Fields[I].FieldName,
  563.         Format('%d,%d,%d', [Fields[I].Index, Fields[I].DisplayWidth,
  564.         Integer(Fields[I].Visible)]));
  565.     end;
  566.   end;
  567. end;
  568.  
  569. procedure InternalRestoreFields(DataSet: TDataSet; IniFile: TObject;
  570.   const Section: string; RestoreVisible: Boolean);
  571. type
  572.   TFieldInfo = record
  573.     Field: TField;
  574.     EndIndex: Integer;
  575.   end;
  576.   PFieldArray = ^TFieldArray;
  577.   TFieldArray = array[0..(65528 div SizeOf(TFieldInfo)) - 1] of TFieldInfo;
  578. const
  579.   Delims = [' ',','];
  580. var
  581.   I, J: Integer;
  582.   S: string;
  583.   FieldArray: PFieldArray;
  584. begin
  585.   with DataSet do begin
  586.     FieldArray := AllocMemo(FieldCount * SizeOf(TFieldInfo));
  587.     try
  588.       for I := 0 to FieldCount - 1 do begin
  589.         S := IniReadString(IniFile, CheckSection(DataSet, Section),
  590.           Name + Fields[I].FieldName, '');
  591.         FieldArray^[I].Field := Fields[I];
  592.         FieldArray^[I].EndIndex := Fields[I].Index;
  593.         if S <> '' then begin
  594.           FieldArray^[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
  595.             FieldArray^[I].EndIndex);
  596.           Fields[I].DisplayWidth := StrToIntDef(ExtractWord(2, S, Delims),
  597.             Fields[I].DisplayWidth);
  598.           if RestoreVisible then
  599.             Fields[I].Visible := Boolean(StrToIntDef(ExtractWord(3, S, Delims),
  600.               Integer(Fields[I].Visible)));
  601.         end;
  602.       end;
  603.       for I := 0 to FieldCount - 1 do begin
  604.         for J := 0 to FieldCount - 1 do begin
  605.           if FieldArray^[J].EndIndex = I then begin
  606.             FieldArray^[J].Field.Index := FieldArray^[J].EndIndex;
  607.             Break;
  608.           end;
  609.         end;
  610.       end;
  611.     finally
  612.       FreeMemo(Pointer(FieldArray));
  613.     end;
  614.   end;
  615. end;
  616.  
  617. {$IFDEF WIN32}
  618. procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
  619. begin
  620.   InternalSaveFields(DataSet, IniFile, DataSetSectionName(DataSet));
  621. end;
  622.  
  623. procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
  624.   RestoreVisible: Boolean);
  625. begin
  626.   InternalRestoreFields(DataSet, IniFile, DataSetSectionName(DataSet),
  627.     RestoreVisible);
  628. end;
  629. {$ENDIF WIN32}
  630.  
  631. procedure SaveFields(DataSet: TDataSet; IniFile: TIniFile);
  632. begin
  633.   InternalSaveFields(DataSet, IniFile, DataSetSectionName(DataSet));
  634. end;
  635.  
  636. procedure RestoreFields(DataSet: TDataSet; IniFile: TIniFile;
  637.   RestoreVisible: Boolean);
  638. begin
  639.   InternalRestoreFields(DataSet, IniFile, DataSetSectionName(DataSet),
  640.     RestoreVisible);
  641. end;
  642.  
  643. function IsDataSetEmpty(DataSet: TDataSet): Boolean;
  644. begin
  645.   with DataSet do Result := (not Active) or (Eof and Bof);
  646. end;
  647.  
  648. { SQL expressions }
  649.  
  650. function DateToSQL(Value: TDateTime): string;
  651. begin
  652.   Result := IntToStr(Trunc(Value));
  653. end;
  654.  
  655. function FormatSQLDateRange(Date1, Date2: TDateTime;
  656.   const FieldName: string): string;
  657. begin
  658.   Result := TrueExpr;
  659.   if (Date1 = Date2) and (Date1 <> NullDate) then begin
  660.     Result := Format('%s = %s', [FieldName, FormatDateTime(ServerDateFmt,
  661.       Date1)]);
  662.   end
  663.   else if (Date1 <> NullDate) or (Date2 <> NullDate) then begin
  664.     if Date1 = NullDate then
  665.       Result := Format('%s < %s', [FieldName,
  666.         FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
  667.     else if Date2 = NullDate then
  668.       Result := Format('%s > %s', [FieldName,
  669.         FormatDateTime(ServerDateFmt, IncDay(Date1, -1))])
  670.     else
  671.       Result := Format('(%s < %s) AND (%s > %s)',
  672.         [FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
  673.         FieldName, FormatDateTime(ServerDateFmt, IncDay(Date1, -1))]);
  674.   end;
  675. end;
  676.  
  677. function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
  678.   const FieldName: string): string;
  679. begin
  680.   Result := TrueExpr;
  681.   if (Date1 <> NullDate) or (Date2 <> NullDate) then begin
  682.     if Date1 = NullDate then
  683.       Result := Format('%s < %s', [FieldName,
  684.         FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
  685.     else if Date2 = NullDate then
  686.       Result := Format('%s >= %s', [FieldName,
  687.         FormatDateTime(ServerDateFmt, Date1)])
  688.     else
  689.       Result := Format('(%s < %s) AND (%s >= %s)',
  690.         [FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
  691.         FieldName, FormatDateTime(ServerDateFmt, Date1)]);
  692.   end;
  693. end;
  694.  
  695. function FormatSQLNumericRange(const FieldName: string;
  696.   LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
  697. const
  698.   Operators: array[Boolean, 1..2] of string[2] = (('>', '<'), ('>=', '<='));
  699. begin
  700.   Result := TrueExpr;
  701.   if (LowValue = HighValue) and (LowValue <> LowEmpty) then begin
  702.     Result := Format('%s = %g', [FieldName, LowValue]);
  703.   end
  704.   else if (LowValue <> LowEmpty) or (HighValue <> HighEmpty) then begin
  705.     if LowValue = LowEmpty then
  706.       Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 2], HighValue])
  707.     else if HighValue = HighEmpty then
  708.       Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 1], LowValue])
  709.     else begin
  710.       Result := Format('(%s %s %g) AND (%s %s %g)',
  711.         [FieldName, Operators[Inclusive, 2], HighValue,
  712.         FieldName, Operators[Inclusive, 1], LowValue]);
  713.     end;
  714.   end;
  715. end;
  716.  
  717. function StrMaskSQL(const Value: string): string;
  718. begin
  719.   if (Pos('*', Value) = 0) and (Pos('?', Value) = 0) and (Value <> '') then
  720.     Result := '*' + Value + '*'
  721.   else Result := Value;
  722. end;
  723.  
  724. function FormatSQLCondition(const FieldName, Operator, Value: string;
  725.   FieldType: TFieldType; Exact: Boolean): string;
  726. var
  727.   EmptyValue: Boolean;
  728.   FieldValue: string;
  729.   DateValue: TDateTime;
  730.   LogicOperator: string;
  731. begin
  732.   FieldValue := '';
  733.   DateValue := NullDate;
  734.   Exact := Exact or not (FieldType in
  735.     [ftString, ftDate, ftTime, ftDateTime]);
  736.   if FieldType in [ftDate, ftTime, ftDateTime] then begin
  737.     DateValue := StrToDateDef(Value, NullDate);
  738.     EmptyValue := (DateValue = NullDate);
  739.     FieldValue := FormatDateTime(ServerDateFmt, DateValue);
  740.   end
  741.   else begin
  742.     FieldValue := Value;
  743.     EmptyValue := FieldValue = '';
  744.     if not (Exact or EmptyValue) then
  745.       FieldValue := ReplaceStr(ReplaceStr(StrMaskSQL(FieldValue),
  746.         '*', '%'), '?', '_');
  747.     if FieldType = ftString then FieldValue := '''' + FieldValue + '''';
  748.   end;
  749.   LogicOperator := Operator;
  750.   if LogicOperator = '' then begin
  751.     if Exact then LogicOperator := '='
  752.     else begin
  753.       if FieldType = ftString then LogicOperator := 'LIKE'
  754.       else LogicOperator := '>=';
  755.     end;
  756.   end;
  757.   if EmptyValue then Result := TrueExpr
  758.   else if (FieldType = ftDateTime) and Exact then begin
  759.     DateValue := IncDay(DateValue, 1);
  760.     Result := Format('(%s >= %s) and (%s < %s)', [FieldName, FieldValue,
  761.       FieldName, FormatDateTime(ServerDateFmt, DateValue)]);
  762.   end
  763.   else Result := Format('%s %s %s', [FieldName, LogicOperator, FieldValue]);
  764. end;
  765.  
  766. function FormatAnsiSQLCondition(const FieldName, Operator, Value: string;
  767.   FieldType: TFieldType; Exact: Boolean): string;
  768. var
  769.   S, Esc: string;
  770. begin
  771.   Esc := '';
  772.   if not Exact and (FieldType = ftString) then begin
  773.     S := ReplaceStr(ReplaceStr(ReplaceStr(Value, '/', '//'),
  774.       '_', '/_'), '%', '/%');
  775.     if S <> Value then Esc := ' ESCAPE''/''';
  776.   end
  777.   else S := Value;
  778.   Result := FormatSQLCondition(FieldName, Operator, S, FieldType, Exact) + Esc;
  779. end;
  780.  
  781. procedure CheckRequiredField(Field: TField);
  782. begin
  783.   with Field do
  784.     if not ReadOnly and not Calculated and IsNull then begin
  785.       FocusControl;
  786. {$IFDEF WIN32}
  787.   {$IFNDEF RX_D3}
  788.       DBErrorFmt(SFieldRequired, [DisplayName]);
  789.   {$ELSE}
  790.       DatabaseErrorFmt(SFieldRequired, [DisplayName]);
  791.   {$ENDIF}
  792. {$ELSE}
  793.       DBErrorFmt(SFieldRequired, [DisplayName^]);
  794. {$ENDIF WIN32}
  795.     end;
  796. end;
  797.  
  798. procedure CheckRequiredFields(const Fields: array of TField);
  799. var
  800.   I: Integer;
  801. begin
  802.   for I := Low(Fields) to High(Fields) do
  803.     CheckRequiredField(Fields[I]);
  804. end;
  805.  
  806. procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
  807. var
  808.   I: Integer;
  809.   F, FSrc: TField;
  810. begin
  811.   if not (Dest.State in dsEditModes) then _DBError(SNotEditing);
  812.   if ByName then begin
  813.     for I := 0 to Source.FieldCount - 1 do begin
  814.       F := Dest.FindField(Source.Fields[I].FieldName);
  815.       if F <> nil then begin
  816. {$IFDEF WIN32}
  817.         F.Value := Source.Fields[I].Value;
  818. {$ELSE}
  819.         if (F.DataType = Source.Fields[I].DataType) and
  820.           (F.DataSize = Source.Fields[I].DataSize) then
  821.           F.Assign(Source.Fields[I])
  822.         else F.AsString := Source.Fields[I].AsString;
  823. {$ENDIF}
  824.       end;
  825.     end;
  826.   end
  827.   else begin
  828.     for I := 0 to Min(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
  829.     begin
  830.       F := Dest.FindField(Dest.FieldDefs[I].Name);
  831.       FSrc := Source.FindField(Source.FieldDefs[I].Name);
  832.       if (F <> nil) and (FSrc <> nil) then begin
  833. {$IFDEF WIN32}
  834.         F.Value := FSrc.Value;
  835. {$ELSE}
  836.         if F.DataType = FSrc.DataType then F.Assign(FSrc)
  837.         else F.AsString := FSrc.AsString;
  838. {$ENDIF}
  839.       end;
  840.     end;
  841.   end;
  842. end;
  843.  
  844. end.