📄 dblists.pas
字号:
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 + -