dbutils.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit DBUtils;

{$I RX.INC}
{$W-,R-,B-,N+,P+}

interface

uses {$IFDEF WIN32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes, SysUtils, DB, {$IFNDEF RX_D3} DBTables, {$ENDIF} IniFiles;

type

{ TLocateObject }

  TLocateObject = class(TObject)
  private
    FDataSet: TDataSet;
    FLookupField: TField;
    FLookupValue: string;
    FLookupExact, FCaseSensitive: Boolean;
    FBookmark: TBookmark;
    FIndexSwitch: Boolean;
    procedure SetDataSet(Value: TDataSet);
  protected
    function MatchesLookup(Field: TField): Boolean;
    procedure CheckFieldType(Field: TField); virtual;
    procedure ActiveChanged; virtual;
    function LocateFilter: Boolean; virtual;
    function LocateKey: Boolean; virtual;
    function LocateFull: Boolean; virtual;
    function UseKey: Boolean; virtual;
    function FilterApplicable: Boolean; virtual;
    property LookupField: TField read FLookupField;
    property LookupValue: string read FLookupValue;
    property LookupExact: Boolean read FLookupExact;
    property CaseSensitive: Boolean read FCaseSensitive;
    property Bookmark: TBookmark read FBookmark write FBookmark;
  public
    function Locate(const KeyField, KeyValue: string; Exact,
      CaseSensitive: Boolean): Boolean;
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property IndexSwitch: Boolean read FIndexSwitch write FIndexSwitch;
  end;

type
  TCreateLocateObject = function: TLocateObject;
const
  CreateLocateObject: TCreateLocateObject = nil;
function CreateLocate(DataSet: TDataSet): TLocateObject;

{ Utility routines }

function IsDataSetEmpty(DataSet: TDataSet): Boolean;
procedure RefreshQuery(Query: TDataSet);
function DataSetSortedSearch(DataSet: TDataSet; const Value,
  FieldName: string; CaseInsensitive: Boolean): Boolean;
function DataSetSectionName(DataSet: TDataSet): string;
procedure InternalSaveFields(DataSet: TDataSet; IniFile: TObject;
  const Section: string);
procedure InternalRestoreFields(DataSet: TDataSet; IniFile: TObject;
  const Section: string; RestoreVisible: Boolean);
{$IFDEF WIN32}
function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
  RestoreVisible: Boolean);
{$ENDIF WIN32}
procedure SaveFields(DataSet: TDataSet; IniFile: TIniFile);
procedure RestoreFields(DataSet: TDataSet; IniFile: TIniFile;
  RestoreVisible: Boolean);
procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
function ConfirmDelete: Boolean;
procedure ConfirmDataSetCancel(DataSet: TDataSet);
procedure CheckRequiredField(Field: TField);
procedure CheckRequiredFields(const Fields: array of TField);

{ SQL expressions }

function DateToSQL(Value: TDateTime): string;
function FormatSQLDateRange(Date1, Date2: TDateTime;
  const FieldName: string): string;
function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
  const FieldName: string): string;
function FormatSQLNumericRange(const FieldName: string;
  LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
function StrMaskSQL(const Value: string): string;
function FormatSQLCondition(const FieldName, Operator, Value: string;
  FieldType: TFieldType; Exact: Boolean): string;
function FormatAnsiSQLCondition(const FieldName, Operator, Value: string;
  FieldType: TFieldType; Exact: Boolean): string;

const
  TrueExpr = '0=0';

const
  { Server Date formats}
  sdfStandard16 = '''"''mm''/''dd''/''yyyy''"'''; {"mm/dd/yyyy"}
  sdfStandard32 = '''''''dd/mm/yyyy''''''';       {'dd/mm/yyyy'}
  sdfOracle     = '"TO_DATE(''"dd/mm/yyyy"'', ''DD/MM/YYYY'')"';
  sdfInterbase  = '"CAST(''"mm"/"dd"/"yyyy"'' AS DATE)"';
  sdfMSSQL      = '"CONVERT(datetime, ''"mm"/"dd"/"yyyy"'', 103)"';

const
  ServerDateFmt: string[50] = sdfStandard16;

{$IFNDEF WIN32}
type
  TBlobType = ftBlob..ftGraphic;
{$ENDIF}

const
{$IFNDEF RX_D4}
  {$IFDEF WIN32}
  ftBlobTypes = [ftBlob..ftTypedBinary];
  {$ELSE}
  ftBlobTypes = [ftBlob..ftGraphic];
  {$ENDIF}
{$ELSE}
  ftBlobTypes = [Low(TBlobType)..High(TBlobType)];
{$ENDIF RX_D3}
{$IFDEF RX_V110} {$NODEFINE ftBlobTypes} {$ENDIF}

{$IFNDEF RX_D4}
  ftNonTextTypes = [ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic
    {$IFDEF WIN32}, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary
    {$IFDEF RX_D3}, ftCursor {$ENDIF} {$ENDIF}];
  {$IFDEF VER110} { C++ Builder 3 or higher }
  {$NODEFINE ftNonTextTypes}
  (*$HPPEMIT 'namespace Dbutils'*)
  (*$HPPEMIT '{'*)
  (*$HPPEMIT '#define ftNonTextTypes (System::Set<TFieldType, ftUnknown, ftCursor> () \'*)
  (*$HPPEMIT '        << ftBytes << ftVarBytes << ftBlob << ftMemo << ftGraphic \'*)
  (*$HPPEMIT '        << ftFmtMemo << ftParadoxOle << ftDBaseOle << ftTypedBinary << ftCursor )'*)
  (*$HPPEMIT '}'*)
  {$ENDIF}
type
  Largeint = Longint;
  {$IFDEF VER110} {$NODEFINE Largeint} {$ENDIF}
{$ENDIF RX_D4}

{$IFDEF RX_D3}
procedure _DBError(const Msg: string);
{$ELSE}
procedure _DBError(Ident: Word);
{$ENDIF}

implementation

uses Forms, Controls, Dialogs, Consts, DBConsts, RXDConst, VCLUtils, FileUtil,
  AppUtils, rxStrUtils, MaxMin, {$IFNDEF RX_D3} BdeUtils, {$ENDIF}
  {$IFNDEF WIN32} Str16, {$ENDIF} DateUtil;

{ Utility routines }

{$IFDEF RX_D3}
procedure _DBError(const Msg: string);
begin
  DatabaseError(Msg);
{$ELSE}
procedure _DBError(Ident: Word);
begin
  DBError(Ident);
{$ENDIF}
end;

function ConfirmDelete: Boolean;
begin
  Screen.Cursor := crDefault;
  Result := MessageDlg(ResStr(SDeleteRecordQuestion), mtConfirmation,
    [mbYes, mbNo], 0) = mrYes;
end;

procedure ConfirmDataSetCancel(DataSet: TDataSet);
begin
  if DataSet.State in [dsEdit, dsInsert] then begin
    DataSet.UpdateRecord;
    if DataSet.Modified then begin
      case MessageDlg(LoadStr(SConfirmSave), mtConfirmation, mbYesNoCancel, 0) of
        mrYes: DataSet.Post;
        mrNo: DataSet.Cancel;
        else SysUtils.Abort;
      end;
    end
    else DataSet.Cancel;
  end;
end;

{$IFDEF RX_D3}
function SetToBookmark(ADataSet: TDataSet; ABookmark: TBookmark): Boolean;
begin
  Result := False;
  with ADataSet do
    if Active and (ABookmark <> nil) and not (Bof and Eof) and
      BookmarkValid(ABookmark) then
    try
      ADataSet.GotoBookmark(ABookmark);
      Result := True;
    except
    end;
end;
{$ENDIF}

{ Refresh Query procedure }

procedure RefreshQuery(Query: TDataSet);
var
  BookMk: TBookmark;
begin
  with Query do begin
    DisableControls;
    try
      if Active then BookMk := GetBookmark else BookMk := nil;
      try
        Close;
        Open;
{$IFDEF RX_D3}
        SetToBookmark(Query, BookMk);
{$ELSE}
        if Query is TDBDataSet then SetToBookmark(Query, BookMk);
{$ENDIF}
      finally
        if BookMk <> nil then FreeBookmark(BookMk);
      end;
    finally
      EnableControls;
    end;
  end;
end;

{ TLocateObject }

procedure TLocateObject.SetDataSet(Value: TDataSet);
begin
  ActiveChanged;
  FDataSet := Value;
end;

function TLocateObject.LocateFull: Boolean;
begin
  Result := False;
  with DataSet do begin
    First;
    while not EOF do begin
      if MatchesLookup(FLookupField) then begin
        Result := True;
        Break;
      end;
      Next;
    end;
  end;
end;

function TLocateObject.LocateKey: Boolean;
begin
  Result := False;
end;

function TLocateObject.FilterApplicable: Boolean;
begin
{$IFDEF RX_D3}
  Result := FLookupField.FieldKind in [fkData, fkInternalCalc];
{$ELSE}
  Result := ({$IFDEF WIN32} FLookupField.FieldKind = fkData {$ELSE}
    not FLookupField.Calculated {$ENDIF}) and IsFilterApplicable(DataSet);
{$ENDIF}
end;

function TLocateObject.LocateFilter: Boolean;
{$IFDEF WIN32}
var
  SaveCursor: TCursor;
  Options: TLocateOptions;
  Value: Variant;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    Options := [];
    if not FCaseSensitive then Include(Options, loCaseInsensitive);
    if not FLookupExact then Include(Options, loPartialKey);
    if (FLookupValue = '') then VarClear(Value)
    else Value := FLookupValue;
    Result := DataSet.Locate(FLookupField.FieldName, Value, Options);
  finally
    Screen.Cursor := SaveCursor;
  end;
{$ELSE}
begin
  Result := False;
{$ENDIF}
end;

procedure TLocateObject.CheckFieldType(Field: TField);
begin
end;

function TLocateObject.Locate(const KeyField, KeyValue: string;
  Exact, CaseSensitive: Boolean): Boolean;
var
  LookupKey: TField;
begin
  if DataSet = nil then begin
    Result := False;
    Exit;
  end;
  DataSet.CheckBrowseMode;
  LookupKey := DataSet.FieldByName(KeyField);
  DataSet.CursorPosChanged;
  FLookupField := LookupKey;
  FLookupValue := KeyValue;
  FLookupExact := Exact;
  FCaseSensitive := CaseSensitive;
  if FLookupField.DataType <> ftString then begin
    FCaseSensitive := True;
    try
      CheckFieldType(FLookupField);
    except
      Result := False;
      Exit;
    end;
  end;
  FBookmark := DataSet.GetBookmark;
  try
    DataSet.DisableControls;
    try
      Result := MatchesLookup(FLookupField);
      if not Result then begin
        if UseKey then Result := LocateKey
        else begin
          if FilterApplicable then Result := LocateFilter
          else Result := LocateFull;
        end;
        if not Result then SetToBookmark(DataSet, FBookmark);
      end;
    finally
      DataSet.EnableControls;
    end;
  finally
    FLookupValue := EmptyStr;
    FLookupField := nil;
    DataSet.FreeBookmark(FBookmark);
    FBookmark := nil;
  end;
end;

function TLocateObject.UseKey: Boolean;
begin
  Result := False;
end;

procedure TLocateObject.ActiveChanged;
begin
end;

function TLocateObject.MatchesLookup(Field: TField): Boolean;
var
  Temp: string;
begin
  Temp := Field.AsString;
  if not FLookupExact then
    SetLength(Temp, Min(Length(FLookupValue), Length(Temp)));
  if FCaseSensitive then Result := AnsiCompareStr(Temp, FLookupValue) = 0
  else Result := AnsiCompareText(Temp, FLookupValue) = 0;
end;

function CreateLocate(DataSet: TDataSet): TLocateObject;
begin
  if Assigned(CreateLocateObject) then Result := CreateLocateObject
  else Result := TLocateObject.Create;
  if (Result <> nil) and (DataSet <> nil) then
    Result.DataSet := DataSet;
end;

{ DataSet locate routines }

{$IFDEF WIN32}
function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  FieldCount: Integer;
  Fields: TList;
  Bookmark: TBookmarkStr;

  function CompareField(Field: TField; Value: Variant): Boolean;
  var
    S: string;
  begin
    if Field.DataType = ftString then begin
      S := Field.AsString;
      if (loPartialKey in Options) then
        Delete(S, Length(Value) + 1, MaxInt);
      if (loCaseInsensitive in Options) then
        Result := AnsiCompareText(S, Value) = 0
      else
        Result := AnsiCompareStr(S, Value) = 0;
    end
    else Result := (Field.Value = Value);
  end;

  function CompareRecord: Boolean;
  var
    I: Integer;
  begin
    if FieldCount = 1 then
      Result := CompareField(TField(Fields.First), KeyValues)
    else begin
      Result := True;
      for I := 0 to FieldCount - 1 do
        Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
    end;
  end;