⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dblists.pas

📁 企业端数据申报系统:单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  end;
end;

procedure TCustomBDEItems.CloseCursor;
begin
  inherited CloseCursor;
  if FSessionLink <> nil then begin
    TSessionLink(FSessionLink).FList := nil;
    FSessionLink.Free;
    FSessionLink := nil;
  end;
end;
{$ENDIF WIN32}

{$IFDEF WIN32}
function TCustomBDEItems.GetRecordCount: {$IFNDEF RX_D3} Longint {$ELSE} Integer {$ENDIF};
begin
  Result := dsGetRecordCount(Self);
end;
{$ENDIF WIN32}

{$IFDEF RX_D3}
function TCustomBDEItems.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;
{$ENDIF RX_D3}

{ TDBListDataSet }

{$IFDEF RX_D3}
function TDBListDataSet.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;
{$ENDIF RX_D3}

{$IFDEF WIN32}
function TDBListDataSet.GetRecordCount: {$IFNDEF RX_D3} Longint {$ELSE} Integer {$ENDIF};
begin
  Result := dsGetRecordCount(Self);
end;
{$ENDIF WIN32}

{ TCustomDatabaseItems }

procedure TCustomDatabaseItems.SetItemType(Value: TDBItemType);
begin
  if ItemType <> Value then begin
    CheckInactive;
    FItemType := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TCustomDatabaseItems.SetFileMask(const Value: string);
begin
  if FileMask <> Value then begin
    if Active and (FItemType in [dtTables, dtFiles]) then begin
      DisableControls;
      try
        Close;
        FFileMask := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else FFileMask := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TCustomDatabaseItems.SetExtendedInfo(Value: Boolean);
begin
  if FExtended <> Value then begin
    CheckInactive;
    FExtended := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TCustomDatabaseItems.SetSystemItems(Value: Boolean);
begin
  if FSystemItems <> Value then begin
    if Active and (FItemType in [dtTables, dtStoredProcs]) then begin
      DisableControls;
      try
        Close;
        FSystemItems := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else FSystemItems := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

function TCustomDatabaseItems.CreateHandle: HDBICur;
var
  WildCard: PChar;
  Pattern: array[0..DBIMAXTBLNAMELEN] of Char;
begin
  WildCard := nil;
  if FileMask <> '' then
    WildCard := AnsiToNative(DBLocale, FileMask, Pattern, SizeOf(Pattern) - 1);
  case FItemType of
    dtTables: Check(DbiOpenTableList(DBHandle, FExtended, FSystemItems, WildCard, Result));
    dtStoredProcs:
      if DataBase.IsSQLBased then
        Check(DbiOpenSPList(DBHandle, FExtended, FSystemItems, nil, Result))
      else DatabaseError(LoadStr(SLocalDatabase));
    dtFiles: Check(DbiOpenFileList(DBHandle, WildCard, Result));
{$IFDEF WIN32}
    dtFunctions:
      if DataBase.IsSQLBased then
        Check(DbiOpenFunctionList(DBHandle, DBIFUNCOpts(FExtended), @Result))
      else DatabaseError(LoadStr(SLocalDatabase));
{$ENDIF}
  end;
end;

function TCustomDatabaseItems.GetItemName: string;
const
  sObjListNameField = 'NAME';
  sFileNameField = 'FILENAME';
  sTabListExtField  = 'EXTENSION';
var
  Temp: string;
  Field: TField;
begin
  Result := '';
  if not Active then Exit;
  if FItemType = dtFiles then Field := FindField(sFileNameField)
  else Field := FindField(sObjListNameField);
  if Field = nil then Exit;
  Result := Field.AsString;
  if FItemType in [dtTables, dtFiles] then begin
    Field := FindField(sTabListExtField);
    if Field = nil then Exit;
    Temp := Field.AsString;
    if Temp <> '' then begin
      if Temp[1] <> '.' then Temp := '.' + Temp;
      Result := Result + Temp;
    end;
  end;
end;

{ TCustomTableItems }

procedure TCustomTableItems.SetItemType(Value: TTabItemType);
begin
  if ItemType <> Value then begin
    CheckInactive;
    FItemType := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TCustomTableItems.SetPhysTypes(Value: Boolean);
begin
  if Value <> PhysTypes then begin
    if Active and (ItemType = dtFields) then begin
      DisableControls;
      try
        Close;
        FPhysTypes := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else FPhysTypes := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TCustomTableItems.SetTableName(const Value: TFileName);
begin
  if Value <> FTableName then begin
    if Active then begin
      DisableControls;
      try
        Close;
        FTableName := Value;
        if FTableName <> '' then Open;
      finally
        EnableControls;
      end;
    end
    else FTableName := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

function TCustomTableItems.CreateHandle: HDBICur;
var
  STableName: PChar;
begin
  if FTableName = '' then _DBError(SNoTableName);
  STableName := StrAlloc(Length(FTableName) + 1);
  try
    AnsiToNative(DBLocale, FTableName, STableName, Length(FTableName));
    case FItemType of
      dtFields:
        while not CheckOpen(DbiOpenFieldList(DBHandle, STableName, nil,
          FPhysTypes, Result)) do {Retry};
      dtIndices:
        while not CheckOpen(DbiOpenIndexList(DBHandle, STableName, nil,
          Result)) do {Retry};
      dtValChecks:
        while not CheckOpen(DbiOpenVchkList(DBHandle, STableName, nil,
          Result)) do {Retry};
      dtRefInt:
        while not CheckOpen(DbiOpenRintList(DBHandle, STableName, nil,
          Result)) do {Retry};
      dtSecurity:
        while not CheckOpen(DbiOpenSecurityList(DBHandle, STableName, nil,
          Result)) do {Retry};
      dtFamily:
        while not CheckOpen(DbiOpenFamilyList(DBHandle, STableName, nil,
          Result)) do {Retry};
    end;
  finally
    StrDispose(STableName);
  end;
end;

{ TDatabaseDesc }

constructor TDatabaseDesc.Create(const DatabaseName: string);
var
  Buffer: PChar;
begin
  Buffer := StrPCopy(StrAlloc(Length(DatabaseName) + 1), DatabaseName);
  try
    Check(DbiGetDatabaseDesc(Buffer, @FDescription));
  finally
    StrDispose(Buffer);
  end;
end;

{ TDriverDesc }

constructor TDriverDesc.Create(const DriverType: string);
var
  Buffer: PChar;
begin
  Buffer := StrPCopy(StrAlloc(Length(DriverType) + 1), DriverType);
  try
    Check(DbiGetDriverDesc(Buffer, FDescription));
  finally
    StrDispose(Buffer);
  end;
end;

{*************************************************************************}

{$IFNDEF CBUILDER}

{ TLangDrivList }

constructor TLangDrivList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := bdLangDrivers;
end;

{ TTableList }

function TTableList.GetTableName: string;
begin
  Result := ItemName;
end;

{ TStoredProcList }

constructor TStoredProcList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := dtStoredProcs;
end;

{ TIndexList }

constructor TIndexList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := dtIndices;
end;

{$ENDIF CBUILDER}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -