home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
sibylft1.zip
/
DOC.DAT
/
DOC
/
SPCC
/
DBBASE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-04-07
|
18KB
|
435 lines
{╔══════════════════════════════════════════════════════════════════════════╗
║ ║
║ Sibyl Portable Component Classes ║
║ ║
║ Copyright (c) 1995,97 SpeedSoft Germany, All rights reserved. ║
║ ║
╚══════════════════════════════════════════════════════════════════════════╝}
UNIT DBBase;
INTERFACE
USES Dos,SysUtils,Classes,Forms,Dialogs,DbLayer;
TYPE
TField=CLASS;
TDataSet=CLASS;
TDataSource=CLASS;
ESQLError=CLASS(Exception);
TDataChange=(dePositionChanged,deDataBaseChanged);
TDataChangeEvent=PROCEDURE(Sender:TObject;Event:TDataChange) OF OBJECT;
TDataLink=CLASS(TComponent)
PRIVATE
FDataSource:TDataSource;
FOnDataChange:TDataChangeEvent;
PROCEDURE SetDataSource(NewValue:TDataSource);
PROCEDURE Notification(AComponent:TComponent;Operation:TOperation);OVERRIDE;
PROCEDURE DataChange(Event:TDataChange);
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
DESTRUCTOR Destroy;OVERRIDE;
PROPERTY DataSource:TDataSource read FDataSource write SetDataSource;
PROPERTY OnDataChange:TDataChangeEvent read FOnDataChange write FOnDataChange;
END;
TTableDataLink=CLASS(TDataLink)
PRIVATE
FUNCTION GetColRowField(Col,Row:LONGINT):TField;
FUNCTION GetNameRowField(Name:STRING;Row:LONGINT):TField;
FUNCTION GetFieldCount:LONGINT;
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
PROPERTY Fields[Col,Row:LONGINT]:TField read GetColRowField;
PROPERTY FieldsFromColumnName[Col:STRING;Row:LONGINT]:TField read GetNameRowField;
PROPERTY FieldCount:LONGINT read GetFieldCount;
END;
TFieldDataLink=CLASS(TDataLink)
PRIVATE
FFieldName:PString;
PROCEDURE SetFieldName(CONST NewValue:STRING);
FUNCTION GetFieldName:STRING;
FUNCTION GetField:TField;
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
DESTRUCTOR Destroy;OVERRIDE;
PROPERTY FieldName:STRING read GetFieldName write SetFieldName;
PROPERTY Field:TField read GetField;
END;
TDataSource=CLASS(TComponent)
PRIVATE
FDataSet:TDataSet;
FOnDataChange:TDataChangeEvent;
PROCEDURE SetDataSet(NewValue:TDataSet);
PROCEDURE Notification(AComponent:TComponent;Operation:TOperation);OVERRIDE;
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
DESTRUCTOR Destroy;OVERRIDE;
PROCEDURE DataChange(Event:TDataChange);VIRTUAL;
PUBLISHED
PROPERTY DataSet:TDataSet read FDataSet write SetDataSet;
PROPERTY OnDataChange:TDataChangeEvent read FOnDataChange write FOnDataChange;
END;
TFieldType=(ftUnknown,ftString,ftSmallInt,ftInteger,ftWord,ftBoolean,
ftFloat,ftCurrency,ftBCD,ftDate,ftTime,ftDateTime,ftBytes,
ftVarBytes,ftAutoInc,ftBlob,ftMemo,ftGraphic,ftFmtMemo,
ftTypedBinary,ftOLE);
EDataBaseError=CLASS(Exception);
TField=CLASS
PRIVATE
FFieldName:PString; //remapped from Columns^.ColumnName
FValue:POINTER;
FValueLen:LONGWORD;
FDataType:TFieldType;
FDataSet:TDataSet;
FRow:LONGINT;
FUNCTION GetFieldName:STRING;
FUNCTION GetIsNull:BOOLEAN;
PROCEDURE SetNewValue(CONST Value;ValueLen:LONGINT);
PROTECTED
FUNCTION GetAsString:STRING;VIRTUAL;
PROCEDURE SetAsString(CONST NewValue:STRING);VIRTUAL;
FUNCTION GetAsBoolean:BOOLEAN;VIRTUAL;
PROCEDURE SetAsBoolean(NewValue:BOOLEAN);VIRTUAL;
FUNCTION GetAsDateTime:TDateTime;VIRTUAL;
PROCEDURE SetAsDateTime(NewValue:TDateTime);VIRTUAL;
FUNCTION GetAsFloat:EXTENDED;VIRTUAL;
PROCEDURE SetAsFloat(CONST NewValue:EXTENDED);VIRTUAL;
FUNCTION GetAsInteger:LONGINT;VIRTUAL;
PROCEDURE SetAsInteger(NewValue:LONGINT);VIRTUAL;
PROCEDURE AccessError(CONST TypeName:STRING);VIRTUAL;
PUBLIC
DESTRUCTOR Destroy;OVERRIDE;
PROPERTY IsNull:BOOLEAN read GetIsNull;
PROPERTY ValueLen:LONGWORD read FValueLen;
PROPERTY DataType:TFieldType read FDataType;
PUBLISHED
PROPERTY FieldName:STRING read GetFieldName;
PROPERTY AsString:STRING read GetAsString write SetAsString;
PROPERTY AsBoolean:BOOLEAN read GetAsBoolean write SetAsBoolean;
PROPERTY AsDateTime:TDateTime read GetAsDateTime write SetAsDateTime;
PROPERTY AsFloat:EXTENDED read GetAsFloat write SetAsFloat;
PROPERTY AsInteger:Longint read GetAsInteger write SetAsInteger;
END;
TFieldClass=CLASS OF TField;
TStringField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsBoolean:BOOLEAN;OVERRIDE;
PROCEDURE SetAsBoolean(NewValue:BOOLEAN);OVERRIDE;
FUNCTION GetAsDateTime:TDateTime;OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
PROCEDURE SetAsFloat(CONST NewValue:EXTENDED);OVERRIDE;
FUNCTION GetAsInteger:LONGINT;OVERRIDE;
PROCEDURE SetAsInteger(NewValue:LONGINT);OVERRIDE;
PUBLIC
PROPERTY Value:STRING read GetAsString;
END;
TSmallintField=CLASS(TField)
PROTECTED
FUNCTION GetAsBoolean:Boolean;OVERRIDE;
PROCEDURE SetAsBoolean(NewValue:BOOLEAN);OVERRIDE;
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsSmallint:INTEGER;VIRTUAL;
PROCEDURE SetAsSmallInt(NewValue:Integer);VIRTUAL;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
PROCEDURE SetAsFloat(CONST NewValue:EXTENDED);OVERRIDE;
FUNCTION GetAsInteger:LONGINT;OVERRIDE;
PROCEDURE SetAsInteger(NewValue:LONGINT);OVERRIDE;
PUBLIC
PROPERTY Value:INTEGER read GetAsSmallInt write SetAsSmallInt;
END;
TIntegerField=CLASS(TField)
PROTECTED
FUNCTION GetAsBoolean:Boolean;OVERRIDE;
PROCEDURE SetAsBoolean(NewValue:BOOLEAN);OVERRIDE;
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
PROCEDURE SetAsFloat(CONST NewValue:EXTENDED);OVERRIDE;
FUNCTION GetAsInteger:LONGINT;OVERRIDE;
PROCEDURE SetAsInteger(NewValue:LONGINT);OVERRIDE;
PUBLIC
PROPERTY Value:LONGINT read GetAsInteger write SetAsInteger;
END;
TFloatField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
PROCEDURE SetAsFloat(CONST NewValue:EXTENDED);OVERRIDE;
FUNCTION GetAsInteger:LONGINT;OVERRIDE;
PROCEDURE SetAsInteger(NewValue:LONGINT);OVERRIDE;
PUBLIC
PROPERTY Value:EXTENDED read GetAsFloat write SetAsFloat;
END;
TDateField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
FUNCTION GetAsDateTime:TDateTime;OVERRIDE;
PROCEDURE SetAsDateTime(NewValue:TDateTime);OVERRIDE;
PUBLIC
PROPERTY Value:TDateTime read GetAsDateTime write SetAsDateTime;
END;
TTimeField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
FUNCTION GetAsDateTime:TDateTime;OVERRIDE;
PROCEDURE SetAsDateTime(NewValue:TDateTime);OVERRIDE;
PUBLIC
PROPERTY Value:TDateTime read GetAsDateTime write SetAsDateTime;
END;
TDateTimeField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PROCEDURE SetAsString(CONST NewValue:STRING);OVERRIDE;
FUNCTION GetAsFloat:EXTENDED;OVERRIDE;
FUNCTION GetAsDateTime:TDateTime;OVERRIDE;
PROCEDURE SetAsDateTime(NewValue:TDateTime);OVERRIDE;
PUBLIC
PROPERTY Value:TDateTime read GetAsDateTime write SetAsDateTime;
END;
TBlobField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
PUBLIC
PROPERTY Value:POINTER read FValue;
END;
TMemoField=CLASS(TField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
END;
TGraphicField=CLASS(TBlobField)
PROTECTED
FUNCTION GetAsString:STRING;OVERRIDE;
END;
TFieldList=CLASS(TList) //List of fields (TField entries)
PUBLIC
PROCEDURE Clear;OVERRIDE;
END;
TDataSetList=CLASS(TList) //List of columns (TDataSetEntry entries)
PRIVATE
FUNCTION Rows:LONGINT;
PUBLIC
PROCEDURE Clear;OVERRIDE;
END;
TDataSetNotifyEvent=PROCEDURE(DataSet:TDataSet) OF OBJECT;
TDataSet=CLASS(TComponent)
PRIVATE
FCurrentRow:LONGINT;
FRowIsInserted:BOOLEAN;
FCurrentField:LONGINT;
FFieldData:TDataSetList; //List of columns (TDataSetEntry Entries)
FActive:BOOLEAN;
FQueryList:TList;
FDBProcs:TDBProcs;
FOpened:BOOLEAN;
FServer:PString;
FDataBase:PString;
FDataSetLocked:BOOLEAN;
FRefreshOnLoad:BOOLEAN;
FSelect:TStrings;
FViewActive:BOOLEAN;
FViewName:STRING[64];
FDataChangeLock:BOOLEAN;
FBeforeOpen:TDataSetNotifyEvent;
FAfterOpen:TDataSetNotifyEvent;
FBeforeClose:TDataSetNotifyEvent;
FAfterClose:TDataSetNotifyEvent;
FBeforeInsert:TDataSetNotifyEvent;
FAfterInsert:TDataSetNotifyEvent;
FBeforePost:TDataSetNotifyEvent;
FAfterPost:TDataSetNotifyEvent;
FBeforeCancel:TDataSetNotifyEvent;
FAfterCancel:TDataSetNotifyEvent;
FBeforeDelete:TDataSetNotifyEvent;
FAfterDelete:TDataSetNotifyEvent;
PRIVATE
FUNCTION GetBOF:BOOLEAN;
FUNCTION GetEOF:BOOLEAN;
FUNCTION GetField(Index:LONGINT):TField;
FUNCTION GetFieldCount:LONGINT;
FUNCTION GetFieldName(Index:LONGINT):STRING;
PROCEDURE SetCurrentField(NewValue:LONGINT);
PROCEDURE SetCurrentRow(NewValue:LONGINT);
PROCEDURE SetActive(NewValue:BOOLEAN);VIRTUAL;
FUNCTION GetResultColRow(Col,Row:LONGINT):TField;
FUNCTION GetLastRowFetched:LONGINT;
FUNCTION GetDataBase:STRING;
PROCEDURE SetDataBase(NewValue:STRING);
PROCEDURE UpdateField(Field:TField;OldValue:POINTER;OldValueLen:LONGINT);
FUNCTION UpdateFieldSelect(Field:TField):BOOLEAN;
PROCEDURE QueryTable(VAR FDbProcs:TDBProcs);
PROCEDURE CloseStmt(CloseView:BOOLEAN);
PROCEDURE CommitInsert(Commit:BOOLEAN);
FUNCTION GetFieldFromColumnName(ColumnName:STRING):TField;
FUNCTION GetServer:STRING;
PROCEDURE SetServer(NewValue:STRING);
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PROCEDURE Loaded;OVERRIDE;
PUBLIC
PROCEDURE Close;VIRTUAL;
DESTRUCTOR Destroy;OVERRIDE;
PROCEDURE First;
PROCEDURE Last;
PROCEDURE Next;
PROCEDURE Prior;
PROCEDURE MoveBy(Distance:LONGINT);
PROCEDURE DataChange(Event:TDataChange);VIRTUAL;
PROCEDURE Refresh;
FUNCTION WriteSCUResource(Stream:TResourceStream):BOOLEAN;OVERRIDE;
PROCEDURE ReadSCUResource(CONST ResName:TResourceName;VAR Data;DataLen:LONGINT);OVERRIDE;
PROCEDURE Post;
PROCEDURE Cancel;
PROCEDURE Insert;
PROCEDURE Append;
PROCEDURE Delete;
PROCEDURE GetFieldNames(List:TStrings);
PROCEDURE GetDataSources(List:TStrings);
PROCEDURE Open;VIRTUAL;
PROCEDURE RefreshTable;VIRTUAL;
PROCEDURE AppendRecord(CONST Values:ARRAY OF CONST);
PROCEDURE SetFields(CONST Values:ARRAY OF CONST);
PROCEDURE InsertRecord(CONST Values:ARRAY OF CONST);
FUNCTION FieldByName(CONST FieldName:STRING):TField;
PUBLIC
PROPERTY BOF:BOOLEAN read GetBOF;
PROPERTY EOF:BOOLEAN read GetEOF;
PROPERTY FieldCount:LONGINT read GetFieldCount;
PROPERTY Fields[Index:LONGINT]:TField read GetField;
PROPERTY FieldNames[Index:LONGINT]:STRING read GetFieldName;
PROPERTY CurrentField:LONGINT read FCurrentField write SetCurrentField;
PROPERTY CurrentRow:LONGINT read FCurrentRow write SetCurrentRow;
PROPERTY LastRowFetched:LONGINT read GetLastRowFetched;
PROPERTY RowInserted:BOOLEAN read FRowIsInserted;
PROPERTY FieldFromColumnName[ColumnName:STRING]:TField read GetFieldFromColumnName;
PROPERTY DataChangeLock:BOOLEAN read FDataChangeLock write FDataChangeLock;
PUBLISHED
PROPERTY Active:BOOLEAN read FActive write SetActive;
PROPERTY Server:STRING read GetServer write SetServer;
PROPERTY DataBase:STRING read GetDataBase write SetDataBase;
PUBLISHED
PROPERTY BeforeOpen:TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
PROPERTY AfterOpen:TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
PROPERTY BeforeClose:TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
PROPERTY AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
PROPERTY BeforeInsert:TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
PROPERTY AfterInsert:TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
PROPERTY BeforePost:TDataSetNotifyEvent read FBeforePost write FBeforePost;
PROPERTY AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
PROPERTY BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
PROPERTY AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
PROPERTY BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
PROPERTY AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
END;
TLockType=(ltReadLock,ltWriteLock);
TTable=CLASS(TDataSet)
PRIVATE
FTable:PString;
FPrimaryKeys:TStringList;
FMasterSource:TDataSource;
FTempMasterSource:TDataSource;
FMasterFields:^STRING;
FServants:TList; //Servants that are connected with this
PRIVATE
FUNCTION GetPassword:STRING;
FUNCTION GetUserId:STRING;
PROCEDURE SetPassword(NewValue:STRING);
PROCEDURE SetUserId(NewValue:STRING);
PROCEDURE SetActive(NewValue:BOOLEAN);OVERRIDE;
PROCEDURE SetTableName(NewValue:STRING);
FUNCTION GetTableName:STRING;
PROCEDURE SetTableLock(Typ:TLockType;Lock:Boolean);
PROCEDURE SetMasterSource(NewValue:TDataSource);
FUNCTION GetMasterFields:STRING;
PROCEDURE SetMasterFields(CONST NewValue:STRING);
PROCEDURE ConnectServant(Servant:TTable;Connect:BOOLEAN);
PROCEDURE DataChange(Event:TDataChange);OVERRIDE;
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
DESTRUCTOR Destroy;OVERRIDE;
PROCEDURE Open;OVERRIDE;
PROCEDURE Close;OVERRIDE;
PROCEDURE RefreshTable;OVERRIDE;
FUNCTION WriteSCUResource(Stream:TResourceStream):BOOLEAN;OVERRIDE;
PROCEDURE ReadSCUResource(CONST ResName:TResourceName;VAR Data;DataLen:LONGINT);OVERRIDE;
PROCEDURE LockTable(LockType:TLockType);
PROCEDURE UnlockTable(LockType:TLockType);
PROCEDURE GetPrimaryKeys(List:TStrings);
PROCEDURE GetTableNames(List:TStrings);
PROTECTED
PROCEDURE Loaded;OVERRIDE;
PROCEDURE UpdateLinkList(CONST PropertyName:STRING;LinkList:TList);OVERRIDE;
PUBLISHED
PROPERTY TableName:STRING read GetTableName write SetTableName;
PROPERTY Password:STRING read GetPassword write SetPassword;
PROPERTY UserId:STRING read GetUserId write SetUserId;
PROPERTY MasterSource:TDataSource read FMasterSource write SetMasterSource;
PROPERTY MasterFields:STRING read GetMasterFields write SetMasterFields;
END;
TQuery=CLASS(TTable)
PRIVATE
PROPERTY TableName;
PROPERTY MasterFields;
PROPERTY MasterSource;
PROCEDURE SetSQL(NewValue:TStrings);
PROTECTED
PROCEDURE SetupComponent;OVERRIDE;
PUBLIC
PROCEDURE RefreshTable;OVERRIDE;
FUNCTION WriteSCUResource(Stream:TResourceStream):BOOLEAN;OVERRIDE;
PROCEDURE ReadSCUResource(CONST ResName:TResourceName;VAR Data;DataLen:LONGINT);OVERRIDE;
PUBLISHED
PROPERTY SQL:TStrings read FSelect write SetSQL;
END;
IMPLEMENTATION