home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / DBBASE.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-21  |  229KB  |  7,408 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit DBBase;                 
  11.  
  12.  
  13. Interface
  14.  
  15.  
  16. Uses Dos,SysUtils,Classes,Forms,Dialogs,DbLayer;
  17.  
  18. Type
  19.     TField=Class;
  20.     TDataSet=Class;
  21.     TDataSource=Class;
  22.  
  23.     ESQLError=Class(Exception);
  24.  
  25.     TDataChange=(dePositionChanged,deDataBaseChanged,deTableNameChanged);
  26.  
  27.     TDataChangeEvent=Procedure(Sender:TObject;event:TDataChange) Of Object;
  28.  
  29.  
  30.     TDataLink=Class(TComponent)
  31.       Private
  32.          FDataSource:TDataSource;
  33.          FOnDataChange:TDataChangeEvent;
  34.          Procedure SetDataSource(NewValue:TDataSource);
  35.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
  36.          Procedure DataChange(event:TDataChange);
  37.       Protected
  38.          Procedure SetupComponent;Override;
  39.       Public
  40.          Destructor Destroy;Override;
  41.          Property DataSource:TDataSource Read FDataSource Write SetDataSource;
  42.          Property OnDataChange:TDataChangeEvent Read FOnDataChange Write FOnDataChange;
  43.     End;
  44.  
  45.  
  46.     TTableDataLink=Class(TDataLink)
  47.       Private
  48.          Function GetColRowField(Col,Row:LongInt):TField;
  49.          Function GetNameRowField(Name:String;Row:LongInt):TField;
  50.          Function GetFieldCount:LongInt;
  51.          Function GetFieldName(Index:LongInt):String;
  52.       Protected
  53.          Procedure SetupComponent;Override;
  54.       Public
  55.          Property Fields[Col,Row:LongInt]:TField Read GetColRowField;
  56.          Property FieldsFromColumnName[Col:String;Row:LongInt]:TField Read GetNameRowField;
  57.          Property FieldCount:LongInt Read GetFieldCount;
  58.          Property FieldNames[Index:LongInt]:String read GetFieldName;
  59.     End;
  60.  
  61.  
  62.     TFieldDataLink=Class(TDataLink)
  63.       Private
  64.          FFieldName:PString;
  65.          Procedure SetFieldName(Const NewValue:String);
  66.          Function GetFieldName:String;
  67.          Function GetField:TField;
  68.       Protected
  69.          Procedure SetupComponent;Override;
  70.       Public
  71.          Destructor Destroy;Override;
  72.          Property FieldName:String Read GetFieldName Write SetFieldName;
  73.          Property field:TField Read GetField;
  74.     End;
  75.  
  76.  
  77.     TDataSource=Class(TComponent)
  78.       Private
  79.          FDataSet:TDataSet;
  80.          FOnDataChange:TDataChangeEvent;
  81.          Procedure SetDataSet(NewValue:TDataSet);
  82.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
  83.       Protected
  84.          Procedure SetupComponent;Override;
  85.          Procedure DataChange(event:TDataChange);Virtual;
  86.       Public
  87.          Destructor Destroy;Override;
  88.       Published
  89.          Property DataSet:TDataSet Read FDataSet Write SetDataSet;
  90.          Property OnDataChange:TDataChangeEvent Read FOnDataChange Write FOnDataChange;
  91.     End;
  92.  
  93.  
  94.     TFieldType=(ftUnknown,ftString,ftSmallInt,ftInteger,ftWord,ftBoolean,
  95.                 ftFloat,ftCurrency,ftBCD,ftDate,ftTime,ftDateTime,ftBytes,
  96.                 ftVarBytes,ftAutoInc,ftBlob,ftMemo,ftGraphic,ftFmtMemo,
  97.                 ftTypedBinary,ftOLE);
  98.  
  99.     EDataBaseError=Class(Exception);
  100.  
  101.     TFieldDefs=Class;
  102.     TFieldDef=Class;
  103.  
  104.     TOnFieldChange=Procedure(Sender:TField) Of Object;
  105.  
  106.     TField=Class
  107.       Private
  108.          FSize:Longword;      //store size of datatype (floatfield!)
  109.          FValue:Pointer;
  110.          FValueLen:LongWord;
  111.          FDataType:TFieldType;
  112.          FDataSet:TDataSet;
  113.          FFieldDef:TFieldDef;
  114.          FRequired:Boolean;
  115.          FRow:LongInt;
  116.          FCol:LongInt;
  117.          FReadOnly:Boolean;
  118.          FOnChange:TOnFieldChange;
  119.          Procedure FreeMemory;
  120.          Procedure GetMemory(Size:Longint);
  121.          Function GetFieldName:String;
  122.          Function GetIsNull:Boolean;
  123.          Procedure SetNewValue(Var NewValue;NewLen:LongInt);
  124.          Function GetAsVariant:Variant;Virtual;
  125.          Procedure SetAsVariant(NewValue:Variant);Virtual;
  126.          Function GetIsIndexField:Boolean;
  127.          Function GetCanModify:Boolean;
  128.          Function GetReadOnly:Boolean;
  129.       Protected
  130.          Procedure SetAsValue(Var Value;Len:LongInt);Virtual;
  131.          Function GetAsString:String;Virtual;
  132.          Procedure SetAsString(Const NewValue:String);Virtual;
  133.          Function GetAsAnsiString:AnsiString;Virtual;
  134.          Procedure SetAsAnsiString(NewValue:AnsiString);Virtual;
  135.          Function GetAsBoolean:Boolean;Virtual;
  136.          Procedure SetAsBoolean(NewValue:Boolean);Virtual;
  137.          Function GetAsDateTime:TDateTime;Virtual;
  138.          Procedure SetAsDateTime(NewValue:TDateTime);Virtual;
  139.          Function GetAsFloat:Extended;Virtual;
  140.          Procedure SetAsFloat(Const NewValue:Extended);Virtual;
  141.          Function GetAsInteger:LongInt;Virtual;
  142.          Procedure SetAsInteger(NewValue:LongInt);Virtual;
  143.          Procedure AccessError(Const TypeName:String);Virtual;
  144.          Procedure CheckInactive;
  145.       Public
  146.          Destructor Destroy;Override;
  147.          Procedure Clear;Virtual;
  148.          Procedure Assign(Field:TField);
  149.          Procedure SetData(Buffer:Pointer);
  150.          Property IsNull:Boolean Read GetIsNull;
  151.          Property ValueLen:LongWord Read FValueLen;
  152.          Property DataType:TFieldType Read FDataType;
  153.          Property Required:Boolean Read FRequired Write FRequired;
  154.          Property Row:LongInt read FRow write FRow;
  155.          Property Value:Variant read GetAsVariant write SetAsVariant;
  156.          Property IsIndexField:Boolean read GetIsIndexField;
  157.          Property CanModify:Boolean read GetCanModify;
  158.          Property DataSet:TDataSet read FDataSet;
  159.          Property DataSize:LongWord read FValueLen;
  160.          Property ReadOnly:boolean read GetReadOnly write FReadOnly;
  161.          Property Index:LongInt read FCol;
  162.       Published
  163.          Property FieldName:String Read GetFieldName;
  164.          Property AsString:String Read GetAsString Write SetAsString;
  165.          Property AsAnsiString:AnsiString Read GetAsAnsiString Write SetAsAnsiString;
  166.          Property AsBoolean:Boolean Read GetAsBoolean Write SetAsBoolean;
  167.          Property AsDateTime:TDateTime Read GetAsDateTime Write SetAsDateTime;
  168.          Property AsFloat:Extended Read GetAsFloat Write SetAsFloat;
  169.          Property AsInteger:LongInt Read GetAsInteger Write SetAsInteger;
  170.          Property OnChange:TOnFieldChange read FOnChange write FOnChange;
  171.     End;
  172.     TFieldClass=Class Of TField;
  173.  
  174.  
  175.     TStringField=Class(TField)
  176.       Protected
  177.          Function GetAsString:String;Override;
  178.          Procedure SetAsString(Const NewValue:String);Override;
  179.          Function GetAsAnsiString:AnsiString;Override;
  180.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  181.          Function GetAsBoolean:Boolean;Override;
  182.          Procedure SetAsBoolean(NewValue:Boolean);Override;
  183.          Function GetAsDateTime:TDateTime;Override;
  184.          Function GetAsFloat:Extended;Override;
  185.          Procedure SetAsFloat(Const NewValue:Extended);Override;
  186.          Function GetAsInteger:LongInt;Override;
  187.          Procedure SetAsInteger(NewValue:LongInt);Override;
  188.          Function GetAsVariant:Variant;Override;
  189.          Procedure SetAsVariant(NewValue:Variant);Override;
  190.       Public
  191.          Property Value:String Read GetAsString write SetAsString;
  192.     End;
  193.  
  194.  
  195.     TSmallintField=Class(TField)
  196.       Protected
  197.          Function GetAsBoolean:Boolean;Override;
  198.          Procedure SetAsBoolean(NewValue:Boolean);Override;
  199.          Function GetAsString:String;Override;
  200.          Procedure SetAsString(Const NewValue:String);Override;
  201.          Function GetAsAnsiString:AnsiString;Override;
  202.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  203.          Function GetAsSmallint:Integer;Virtual;
  204.          Procedure SetAsSmallInt(NewValue:Integer);Virtual;
  205.          Function GetAsFloat:Extended;Override;
  206.          Procedure SetAsFloat(Const NewValue:Extended);Override;
  207.          Function GetAsInteger:LongInt;Override;
  208.          Procedure SetAsInteger(NewValue:LongInt);Override;
  209.          Function GetAsVariant:Variant;Override;
  210.          Procedure SetAsVariant(NewValue:Variant);Override;
  211.       Public
  212.          Property Value:Integer Read GetAsSmallint Write SetAsSmallInt;
  213.     End;
  214.  
  215.  
  216.     TIntegerField=Class(TField)
  217.       Protected
  218.          Function GetAsBoolean:Boolean;Override;
  219.          Procedure SetAsBoolean(NewValue:Boolean);Override;
  220.          Function GetAsString:String;Override;
  221.          Procedure SetAsString(Const NewValue:String);Override;
  222.          Function GetAsAnsiString:AnsiString;Override;
  223.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  224.          Function GetAsFloat:Extended;Override;
  225.          Procedure SetAsFloat(Const NewValue:Extended);Override;
  226.          Function GetAsInteger:LongInt;Override;
  227.          Procedure SetAsInteger(NewValue:LongInt);Override;
  228.          Function GetAsVariant:Variant;Override;
  229.          Procedure SetAsVariant(NewValue:Variant);Override;
  230.       Public
  231.          Property Value:LongInt Read GetAsInteger Write SetAsInteger;
  232.     End;
  233.  
  234.  
  235.     TAutoIncField=Class(TIntegerField)
  236.     End;
  237.  
  238.  
  239.     TBooleanField=Class(TField)
  240.       Protected
  241.          Function GetAsBoolean:Boolean;Override;
  242.          Procedure SetAsBoolean(NewValue:Boolean);Override;
  243.          Function GetAsString:String;Override;
  244.          Procedure SetAsString(Const NewValue:String);Override;
  245.          Function GetAsAnsiString:AnsiString;Override;
  246.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  247.          Function GetAsFloat:Extended;Override;
  248.          Procedure SetAsFloat(Const NewValue:Extended);Override;
  249.          Function GetAsInteger:LongInt;Override;
  250.          Procedure SetAsInteger(NewValue:LongInt);Override;
  251.          Function GetAsVariant:Variant;Override;
  252.          Procedure SetAsVariant(NewValue:Variant);Override;
  253.       Public
  254.          Property Value:Boolean Read GetAsBoolean Write SetAsBoolean;
  255.     End;
  256.  
  257.  
  258.     TFloatField=Class(TField)
  259.       Private
  260.          FPrecision:Longint;
  261.          Procedure SetPrecision(Value:Longint);
  262.       Protected
  263.          Function GetAsString:String;Override;
  264.          Procedure SetAsString(Const NewValue:String);Override;
  265.          Function GetAsAnsiString:AnsiString;Override;
  266.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  267.          Function GetAsFloat:Extended;Override;
  268.          Procedure SetAsFloat(Const NewValue:Extended);Override;
  269.          Function GetAsInteger:LongInt;Override;
  270.          Procedure SetAsInteger(NewValue:LongInt);Override;
  271.          Function GetAsVariant:Variant;Override;
  272.          Procedure SetAsVariant(NewValue:Variant);Override;
  273.       Public
  274.          Constructor Create;
  275.          Property Value:Extended Read GetAsFloat Write SetAsFloat;
  276.          Property Precision:Longint Read FPrecision Write SetPrecision;
  277.     End;
  278.  
  279.  
  280.     TCurrencyField=Class(TFloatField)
  281.       Public
  282.          Constructor Create;
  283.     End;
  284.  
  285.  
  286.     TDateField=Class(TField)
  287.       Private
  288.          FDisplayFormat:PString;
  289.       Private
  290.          Function GetDisplayFormat:String;
  291.          Procedure SetDisplayFormat(Const NewValue:String);
  292.       Protected
  293.          Function GetAsString:String;Override;
  294.          Procedure SetAsString(Const NewValue:String);Override;
  295.          Function GetAsAnsiString:AnsiString;Override;
  296.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  297.          Function GetAsFloat:Extended;Override;
  298.          Function GetAsDateTime:TDateTime;Override;
  299.          Procedure SetAsDateTime(NewValue:TDateTime);Override;
  300.          Function GetAsVariant:Variant;Override;
  301.          Procedure SetAsVariant(NewValue:Variant);Override;
  302.          Destructor Destroy;Override;
  303.       Public
  304.          Property Value:TDateTime Read GetAsDateTime Write SetAsDateTime;
  305.          Property DisplayFormat:String read GetDisplayFormat write SetDisplayFormat;
  306.     End;
  307.  
  308.  
  309.     TTimeField=Class(TField)
  310.       Private
  311.          FDisplayFormat:PString;
  312.       Private
  313.          Function GetDisplayFormat:String;
  314.          Procedure SetDisplayFormat(Const NewValue:String);
  315.       Protected
  316.          Function GetAsString:String;Override;
  317.          Procedure SetAsString(Const NewValue:String);Override;
  318.          Function GetAsAnsiString:AnsiString;Override;
  319.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  320.          Function GetAsFloat:Extended;Override;
  321.          Function GetAsDateTime:TDateTime;Override;
  322.          Procedure SetAsDateTime(NewValue:TDateTime);Override;
  323.          Function GetAsVariant:Variant;Override;
  324.          Procedure SetAsVariant(NewValue:Variant);Override;
  325.          Destructor Destroy;Override;
  326.       Public
  327.          Property Value:TDateTime Read GetAsDateTime Write SetAsDateTime;
  328.          Property DisplayFormat:String read GetDisplayFormat write SetDisplayFormat;
  329.     End;
  330.  
  331.  
  332.     TDateTimeField=Class(TField)
  333.       Private
  334.          FDisplayFormat:PString;
  335.       Private
  336.          Function GetDisplayFormat:String;
  337.          Procedure SetDisplayFormat(Const NewValue:String);
  338.       Protected
  339.          Function GetAsString:String;Override;
  340.          Procedure SetAsString(Const NewValue:String);Override;
  341.          Function GetAsAnsiString:AnsiString;Override;
  342.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  343.          Function GetAsFloat:Extended;Override;
  344.          Function GetAsDateTime:TDateTime;Override;
  345.          Procedure SetAsDateTime(NewValue:TDateTime);Override;
  346.          Function GetAsVariant:Variant;Override;
  347.          Procedure SetAsVariant(NewValue:Variant);Override;
  348.          Destructor Destroy;Override;
  349.       Public
  350.          Property Value:TDateTime Read GetAsDateTime Write SetAsDateTime;
  351.          Property DisplayFormat:String read GetDisplayFormat write SetDisplayFormat;
  352.     End;
  353.  
  354.  
  355.     TBlobField=Class(TField)
  356.       Protected
  357.          Function GetAsString:String;Override;
  358.          Function GetAsAnsiString:AnsiString;Override;
  359.       Public
  360.          Procedure LoadFromStream(Stream:TStream);
  361.          Property Value:Pointer Read FValue;
  362.     End;
  363.  
  364.  
  365.     TMemoField=Class(TField)
  366.       Protected
  367.          Function GetAsString:String;Override;
  368.          Function GetAsAnsiString:AnsiString;Override;
  369.          Procedure SetAsAnsiString(NewValue:AnsiString);Override;
  370.       Public
  371.          Property Value:AnsiString Read GetAsAnsiString write SetAsAnsiString;
  372.     End;
  373.  
  374.  
  375.     TGraphicField=Class(TBlobField)
  376.       Protected
  377.          Function GetAsString:String;Override;
  378.     End;
  379.  
  380.  
  381.     TFieldList=Class(TList)  //List Of Fields (TField entries)
  382.       Public
  383.          Procedure Clear;Override;
  384.     End;
  385.  
  386.  
  387.     TFieldDef=Class
  388.       Private
  389.          FFields:TList;
  390.          FOwner:TFieldDefs;
  391.          FName:String;
  392.          FRequired:Boolean;
  393.          FSize:Longword;
  394.          FPrecision:LongInt;
  395.          FDataType:TFieldType;
  396.          FFieldNo:Longint;
  397.          FPrimaryKey:Boolean;
  398.          FForeignKey:PString;
  399.          FTypeName:PString;
  400.          Function GetFieldClass:TFieldClass;
  401.          Function GetPrimaryKey:Boolean;
  402.          Procedure SetPrimaryKey(NewValue:Boolean);
  403.          Function GetForeignKey:String;
  404.          Procedure SetForeignKey(Const NewValue:String);
  405.          Function GetTypeName:String;
  406.          Procedure SetTypeName(Const NewValue:String);
  407.       Public
  408.          Constructor Create(aOwner:TFieldDefs; Const aName:String;
  409.                             aDataType:TFieldType; aSize:Longword; aRequired:Boolean;
  410.                             aFieldNo:Longint);
  411.          Destructor Destroy;Override;
  412.          Function CreateField(Owner:TComponent):TField;
  413.        Public
  414.          Property Fields:TList Read FFields;
  415.          Property DataType:TFieldType Read FDataType;
  416.          Property FieldClass:TFieldClass Read GetFieldClass;
  417.          Property FieldNo:Longint Read FFieldNo;
  418.          Property Name:String Read FName;
  419.          Property TypeName:String Read GetTypeName write SetTypeName;
  420.          Property Precision:Longint Read FPrecision Write FPrecision;
  421.          Property Required:Boolean Read FRequired;
  422.          Property Size:Longword Read FSize Write FSize;
  423.          Property PrimaryKey:Boolean read GetPrimaryKey write FPrimaryKey;
  424.          Property ForeignKey:String read GetForeignKey write SetForeignKey;
  425.     End;
  426.  
  427.  
  428.     TFieldDefs=Class
  429.       Private
  430.          FDataSet:TDataSet;
  431.          FItems:TList;
  432.          Function Rows:Longint;
  433.          Function GetCount:Longint;
  434.          Function GetItem(Index:Longint):TFieldDef;
  435.       Public
  436.          Constructor Create(DataSet:TDataSet);
  437.          Destructor Destroy;Override;
  438.          Procedure Clear;
  439.          Function Add(Const Name:String; DataType:TFieldType; Size:Longint; Required:Boolean):TFieldDef;
  440.          Procedure Update;
  441.          Procedure Assign(FieldDefs: TFieldDefs);
  442.          Function Find(Const Name: string): TFieldDef;
  443.          Function IndexOf(Const Name: string): LongInt;
  444.       Public
  445.          Property Count:Longint Read GetCount;
  446.          Property Items[Index:Longint]:TFieldDef Read GetItem; default
  447.     End;
  448.  
  449.     TDataSetNotifyEvent=Procedure(DataSet:TDataSet) Of Object;
  450.  
  451.     {$M+}
  452.     TLocateOptions=Set Of (loCaseInsensitive,loPartialKey);
  453.     {$M-}
  454.  
  455.     {$M+}
  456.     TIndexOptions = Set of (ixPrimary, ixUnique, ixDescending,
  457.                             ixCaseInsensitive, ixExpression);
  458.     {$M-}
  459.  
  460.     TDataSet=Class(TComponent)
  461.       Private
  462.          FCurrentRow:LongInt;
  463.          FCurrentField:LongInt;
  464.          FRowIsInserted:Boolean;
  465.          FFieldDefs:TFieldDefs;
  466.          FActive:Boolean;
  467.          FOpened:Boolean;
  468.          FDBProcs:TDBProcs;
  469.          FServer:PString;
  470.          FDataBase:PString;
  471.          FDataSetLocked:Boolean;
  472.          FRefreshOnLoad:Boolean;
  473.          FSelect:TStrings;
  474.          FDataChangeLock:Boolean;
  475.          FMaxRows:LongInt;
  476.          FBeforeOpen:TDataSetNotifyEvent;
  477.          FAfterOpen:TDataSetNotifyEvent;
  478.          FBeforeClose:TDataSetNotifyEvent;
  479.          FAfterClose:TDataSetNotifyEvent;
  480.          FBeforeInsert:TDataSetNotifyEvent;
  481.          FAfterInsert:TDataSetNotifyEvent;
  482.          FBeforePost:TDataSetNotifyEvent;
  483.          FAfterPost:TDataSetNotifyEvent;
  484.          FBeforeCancel:TDataSetNotifyEvent;
  485.          FAfterCancel:TDataSetNotifyEvent;
  486.          FBeforeDelete:TDataSetNotifyEvent;
  487.          FAfterDelete:TDataSetNotifyEvent;
  488.          FReadOnly:Boolean;
  489.       Private
  490.          Function GetBOF:Boolean;
  491.          Function GetEOF:Boolean;
  492.          Function GetField(Index:LongInt):TField;
  493.          Function GetFieldCount:LongInt;
  494.          Function GetFieldName(Index:LongInt):String;
  495.          Function GetFieldType(Index:LongInt):TFieldType;
  496.          Procedure SetCurrentField(NewValue:LongInt);
  497.          Procedure SetCurrentRow(NewValue:LongInt);
  498.          Procedure UpdateField(field:TField;OldValue:Pointer;OldValueLen:LongInt);
  499.          Function GetFieldFromColumnName(ColumnName:String):TField;
  500.          Procedure CheckRequiredFields;
  501.          Procedure SetFieldDefs(NewValue:TFieldDefs);
  502.          Procedure DesignerNotification(Var DNS:TDesignerNotifyStruct);
  503.          Function IsTable:Boolean;
  504.       Protected
  505.          Procedure SetupComponent;Override;
  506.          Procedure Loaded;Override;
  507.          Procedure DataChange(event:TDataChange);Virtual;
  508.          Procedure CheckInactive;Virtual;
  509.          Procedure SetActive(NewValue:Boolean);Virtual;
  510.          Procedure SetDataBaseName(Const NewValue:String);Virtual;
  511.          Function GetDataBaseName:String;Virtual;
  512.          Procedure SetServer(Const NewValue:String);Virtual;
  513.          Function GetServer:String;Virtual;
  514.          Function GetMaxRows:LongInt;Virtual;
  515.          Function GetResultColRow(Col,Row:LongInt):TField;Virtual;
  516.          Procedure CommitInsert(Commit:Boolean);Virtual;
  517.          Function UpdateFieldSelect(Field:TField):Boolean;Virtual;
  518.          Function GetFieldClass(FieldType:TFieldType):TFieldClass;Virtual;
  519.          Procedure InsertCurrentFields;
  520.          Procedure RemoveCurrentFields;
  521.          Procedure QueryTable;Virtual;
  522.          Procedure DoOpen;Virtual;
  523.          Procedure DoClose;Virtual;
  524.          Procedure DoPost;Virtual;
  525.          Procedure DoCancel;Virtual;
  526.          Procedure DoInsert;Virtual;
  527.          Procedure DoDelete;Virtual;
  528.          Property DataSetLocked:Boolean read FDataSetLocked write FDataSetLocked;
  529.       Public
  530.          Destructor Destroy;Override;
  531.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  532.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  533.          Procedure Open;
  534.          Procedure Close;
  535.          Procedure First;
  536.          Procedure Last;
  537.          Procedure Next;
  538.          Procedure Prior;
  539.          Procedure MoveBy(Distance:LongInt);
  540.          Procedure Refresh;
  541.          Procedure Post;Virtual;
  542.          Procedure Cancel;Virtual;
  543.          Procedure Insert;Virtual;
  544.          Procedure Append;Virtual;
  545.          Procedure Delete;Virtual;
  546.          Procedure GetFieldNames(List:TStrings);
  547.          Procedure GetDataSources(List:TStrings);Virtual;
  548.          Procedure GetStoredProcNames(List:TStrings);Virtual;
  549.          Procedure RefreshTable;Virtual;
  550.          Procedure AppendRecord(Const values:Array Of Const);
  551.          Procedure SetFields(Const values:Array Of Const);
  552.          Procedure InsertRecord(Const Values:Array Of Const);Virtual;
  553.          Function FieldByName(Const FieldName:String):TField;
  554.          Function FindField(Const FieldName:String):TField;
  555.          Function FindFirst: Boolean;
  556.          Function FindLast: Boolean;
  557.          Function FindNext: Boolean;
  558.          Function FindPrior: Boolean;
  559.          Procedure GetFieldList(List:TList;Const FieldNames:String);
  560.          Function Locate(Const KeyFields:String;Const KeyValues:Array Of Const;
  561.                          Options:TLocateOptions):Boolean;Virtual;
  562.       Public
  563.          Property Bof:Boolean Read GetBOF;
  564.          Property Eof:Boolean Read GetEOF;
  565.          Property FieldCount:LongInt Read GetFieldCount;
  566.          Property Fields[Index:LongInt]:TField Read GetField;
  567.          Property FieldDefs:TFieldDefs read FFieldDefs write SetFieldDefs;
  568.          Property FieldNames[Index:LongInt]:String Read GetFieldName;
  569.          Property FieldTypes[Index:LongInt]:TFieldType Read GetFieldType;
  570.          Property CurrentField:LongInt Read FCurrentField Write SetCurrentField;
  571.          Property CurrentRow:LongInt Read FCurrentRow Write SetCurrentRow;
  572.          Property RowInserted:Boolean Read FRowIsInserted write FRowIsInserted;
  573.          Property FieldFromColumnName[ColumnName:String]:TField Read GetFieldFromColumnName;
  574.          Property DataChangeLock:Boolean Read FDataChangeLock Write FDataChangeLock;
  575.          Property MaxRows:LongInt read GetMaxRows;
  576.          Property RecordCount:Longint read GetMaxRows;
  577.          Property RecNo:Longint read FCurrentRow;
  578.          Property DataBaseName:String Read GetDataBaseName Write SetDataBaseName;
  579.       Published
  580.          Property Active:Boolean Read FActive Write SetActive;
  581.          Property Server:String Read GetServer Write SetServer;
  582.          Property DataBase:String Read GetDataBaseName Write SetDataBaseName;
  583.          Property ReadOnly:Boolean read FReadOnly write FReadOnly;
  584.          Property BeforeOpen:TDataSetNotifyEvent Read FBeforeOpen Write FBeforeOpen;
  585.          Property AfterOpen:TDataSetNotifyEvent Read FAfterOpen Write FAfterOpen;
  586.          Property BeforeClose:TDataSetNotifyEvent Read FBeforeClose Write FBeforeClose;
  587.          Property AfterClose:TDataSetNotifyEvent Read FAfterClose Write FAfterClose;
  588.          Property BeforeInsert:TDataSetNotifyEvent Read FBeforeInsert Write FBeforeInsert;
  589.          Property AfterInsert:TDataSetNotifyEvent Read FAfterInsert Write FAfterInsert;
  590.          Property BeforePost:TDataSetNotifyEvent Read FBeforePost Write FBeforePost;
  591.          Property AfterPost:TDataSetNotifyEvent Read FAfterPost Write FAfterPost;
  592.          Property BeforeCancel:TDataSetNotifyEvent Read FBeforeCancel Write FBeforeCancel;
  593.          Property AfterCancel:TDataSetNotifyEvent Read FAfterCancel Write FAfterCancel;
  594.          Property BeforeDelete:TDataSetNotifyEvent Read FBeforeDelete Write FBeforeDelete;
  595.          Property AfterDelete:TDataSetNotifyEvent Read FAfterDelete Write FAfterDelete;
  596.     End;
  597.  
  598.     TLockType=(ltReadLock,ltWriteLock);
  599.  
  600.     TIndexDefs=Class;
  601.  
  602.     TIndexDef=Class
  603.       Private
  604.          FOwner: TIndexDefs;
  605.          FName:PString;
  606.          FFields:PString;
  607.          FOptions:TIndexOptions;
  608.          Function GetFields:String;
  609.          Function GetName:String;
  610.       Public
  611.          Constructor Create(Owner:TIndexDefs;Const Name, Fields:String;
  612.                             Options:TIndexOptions);
  613.          Destructor Destroy; override;
  614.       Public
  615.          Property Fields:String read GetFields;
  616.          Property Name:String read GetName;
  617.          Property Options: TIndexOptions read FOptions;
  618.     End;
  619.  
  620.     TIndexDefs=Class
  621.        Private
  622.          FDataSet:TDataSet;
  623.          FItems:TList;
  624.          FUpdated: Boolean;
  625.          Function GetCount:LongInt;
  626.          Function GetItem(Index:LongInt): TIndexDef;
  627.        Public
  628.          Constructor Create(DataSet:TDataSet);
  629.          Destructor Destroy;Override;
  630.          Function Add(Const Name,Fields:String;Options:TIndexOptions):TIndexDef;
  631.          Procedure Assign(IndexDefs:TIndexDefs);
  632.          Procedure Clear;
  633.          Function FindIndexForFields(Const Fields:String):TIndexDef;
  634.          Function GetIndexForFields(Const Fields:String;CaseInsensitive:Boolean):TIndexDef;
  635.          Function IndexOf(Const Name:String):LongInt;
  636.          Procedure Update;
  637.        Public
  638.          Property Count:LongInt read GetCount;
  639.          Property Items[Index:LongInt]:TIndexDef read GetItem;default;
  640.          Property Updated:Boolean read FUpdated write FUpdated;
  641.     End;
  642.  
  643.     TTable=Class(TDataSet)
  644.       Private
  645.          FTableName:PString;
  646.          FMasterSource:TDataSource;
  647.          FTempMasterSource:TDataSource;
  648.          FMasterFields:PString;
  649.          FServants:TList;  //Servants that are connected With This
  650.          FDataTypes:TStringList;
  651.          FIndexDefs:TIndexDefs;
  652.          FIndexFieldMap:TList;
  653.       Private
  654.          Function GetPassword:String;
  655.          Function GetUserId:String;
  656.          Procedure SetPassword(NewValue:String);
  657.          Procedure SetUserId(NewValue:String);
  658.          Procedure SetTableName(NewValue:String);
  659.          Function GetTableName:String;
  660.          Procedure SetTableLock(LockType:TLockType;Lock:Boolean);
  661.          Procedure SetMasterSource(NewValue:TDataSource);
  662.          Function GetMasterFields:String;
  663.          Procedure SetMasterFields(Const NewValue:String);
  664.          Procedure ConnectServant(Servant:TTable;Connect:Boolean);
  665.          Procedure CloseStmt;
  666.          Procedure GetNames(List:TStrings;Const Name:String);
  667.          Procedure GetKeys(List:TStrings;Primary:Boolean);
  668.          Function GetIndexFieldCount:LongInt;
  669.          Function GetIndexField(Index:LongInt):TField;
  670.          Procedure SetIndexField(Index:LongInt;NewValue:TField);
  671.          Function GetIndexDefs:TIndexDefs;
  672.       Protected
  673.          Procedure SetupComponent;Override;
  674.          Procedure SetActive(NewValue:Boolean);Override;
  675.          Function GetResultColRow(Col,Row:LongInt):TField;Override;
  676.          Procedure CommitInsert(Commit:Boolean);Override;
  677.          Function UpdateFieldSelect(Field:TField):Boolean;Override;
  678.          Procedure DataChange(event:TDataChange);Override;
  679.          Procedure QueryTable;Override;
  680.          Procedure DoOpen;Override;
  681.          Procedure DoClose;Override;
  682.          Procedure DoDelete;Override;
  683.          Procedure DoCancel;Override;
  684.          Procedure DoPost;Override;
  685.          Procedure Loaded;Override;
  686.          Procedure UpdateLinkList(Const PropertyName:String;LinkList:TList);Override;
  687.       Public
  688.          Procedure UpdateIndexDefs;Virtual;
  689.          Procedure UpdateFieldDefs;
  690.          Destructor Destroy;Override;
  691.          Procedure RefreshTable;Override;
  692.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  693.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  694.          Procedure GetDataSources(List:TStrings);Override;
  695.          Procedure GetStoredProcNames(List:TStrings);Override;
  696.          Procedure LockTable(LockType:TLockType);Virtual;
  697.          Procedure UnlockTable(LockType:TLockType);Virtual;
  698.          Procedure GetPrimaryKeys(List:TStrings);Virtual;
  699.          Procedure GetTableNames(List:TStrings);Virtual;
  700.          Procedure AddIndex(Const Name:String;Fields:String;Options:TIndexOptions);Virtual;
  701.          Procedure DeleteIndex(Const Name: string);Virtual;
  702.          Procedure CreateTable;Virtual;
  703.          Procedure DeleteTable;Virtual;
  704.          Procedure EmptyTable;Virtual;
  705.          Function FindKey(Const KeyValues:Array of Const):Boolean;Virtual;
  706.          Procedure GetIndexNames(List: TStrings);Virtual;
  707.          Procedure RenameTable(NewTableName:String);Virtual;
  708.          Procedure GetViewNames(List:TStrings);Virtual;
  709.          Procedure GetSystemTableNames(List:TStrings);Virtual;
  710.          Procedure GetSynonymNames(List:TStrings);Virtual;
  711.          Procedure GetDataTypes(List:TStrings);Virtual;
  712.          Procedure GetForeignKeys(List:TStrings);Virtual;
  713.          Function DataType2Name(DataType:TFieldType):String;
  714.       Public
  715.          Property IndexDefs:TIndexDefs read GetIndexDefs;
  716.          Property IndexFieldCount:LongInt read GetIndexFieldCount;
  717.          Property IndexFields[Index:LongInt]:TField read GetIndexField write SetIndexField;
  718.       Published
  719.          Property TableName:String Read GetTableName Write SetTableName;
  720.          Property Password:String Read GetPassword Write SetPassword;
  721.          Property UserId:String Read GetUserId Write SetUserId;
  722.          Property MasterSource:TDataSource Read FMasterSource Write SetMasterSource;
  723.          Property MasterFields:String Read GetMasterFields Write SetMasterFields;
  724.     End;
  725.  
  726.  
  727.     TQuery=Class(TTable)
  728.       Private
  729.          Property TableName;
  730.          Property MasterFields;
  731.          Property MasterSource;
  732.          Property ReadOnly;
  733.          Procedure SetSQL(NewValue:TStrings);
  734.       Protected
  735.          Procedure SetupComponent;Override;
  736.       Public
  737.          Procedure RefreshTable;Override;
  738.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  739.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  740.       Published
  741.          Property SQL:TStrings Read FSelect Write SetSQL;
  742.     End;
  743.  
  744.     TParams = Class;
  745.  
  746.     TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult, ptResultSet);
  747.  
  748.     TParam = Class
  749.       Private
  750.          FParamList: TParams;
  751.          FData: Variant;
  752.          FName:PString;
  753.          FDataType: TFieldType;
  754.          FNull: Boolean;
  755.          FBound: Boolean;
  756.          FParamType: TParamType;
  757.          FResultNTS:CString;
  758.          FResultLongInt:LongInt;
  759.          FResultSmallInt:SmallInt;
  760.          FResultExtended:Extended;
  761.          FResultDate:Record
  762.                          Year:Word;
  763.                          Month:Word;
  764.                          Day:Word;
  765.          End;
  766.          FResultTime:Record
  767.                          Hour:WORD;
  768.                          Minute:WORD;
  769.                          Second:WORD;
  770.          End;
  771.          FResultDateTime:Record
  772.                          Year:Word;
  773.                          Month:Word;
  774.                          Day:Word;
  775.                          Hour:WORD;
  776.                          Minute:WORD;
  777.                          Second:WORD;
  778.                          Fraction:LongWord;
  779.          End;
  780.          FOutLen:SQLINTEGER;
  781.       Private
  782.          Procedure SetAsBCD(Value: Currency);
  783.          Procedure SetAsBoolean(Value: Boolean);
  784.          Procedure SetAsCurrency(Value:Extended);
  785.          Procedure SetAsDate(Value: TDateTime);
  786.          Procedure SetAsDateTime(Value: TDateTime);
  787.          Procedure SetAsFloat(Const Value:Extended);
  788.          Procedure SetAsInteger(Value: Longint);
  789.          Procedure SetAsString(const Value: string);
  790.          Procedure SetAsSmallInt(Value: LongInt);
  791.          Procedure SetAsTime(Value: TDateTime);
  792.          Procedure SetAsVariant(Value: Variant);
  793.          Procedure SetAsWord(Value: LongInt);
  794.          Function GetName:String;
  795.          Procedure SetName(Const NewValue:String);
  796.       Protected
  797.          Function GetAsBCD: Currency;
  798.          Function GetAsBoolean: Boolean;
  799.          Function GetAsDateTime: TDateTime;
  800.          Function GetAsFloat:Extended;
  801.          Function GetAsInteger: Longint;
  802.          Function GetAsString: string;
  803.          Function GetAsVariant: Variant;
  804.          Function IsEqual(Value: TParam): Boolean;
  805.          Procedure SetDataType(Value: TFieldType);
  806.          Procedure SetText(Const Value:String);
  807.       Public
  808.          Constructor Create(AParamList: TParams; AParamType: TParamType);
  809.          Destructor Destroy;Override;
  810.          Procedure Assign(Param: TParam);
  811.          Procedure AssignField(Field: TField);
  812.          Procedure AssignFieldValue(Field:TField;Const Value: Variant);
  813.          Procedure Clear;
  814.       Public
  815.          Property AsBCD: Currency read GetAsBCD write SetAsBCD;
  816.          Property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  817.          Property AsCurrency:Extended read GetAsFloat write SetAsCurrency;
  818.          Property AsDate: TDateTime read GetAsDateTime write SetAsDate;
  819.          Property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  820.          Property AsFloat:Extended read GetAsFloat write SetAsFloat;
  821.          Property AsInteger: LongInt read GetAsInteger write SetAsInteger;
  822.          Property AsSmallInt: LongInt read GetAsInteger write SetAsSmallInt;
  823.          Property AsString:String read GetAsString write SetAsString;
  824.          Property AsTime: TDateTime read GetAsDateTime write SetAsTime;
  825.          Property AsWord: LongInt read GetAsInteger write SetAsWord;
  826.          Property Bound: Boolean read FBound write FBound;
  827.          Property DataType: TFieldType read FDataType write SetDataType;
  828.          Property IsNull: Boolean read FNull;
  829.          Property Name:String read GetName write SetName;
  830.          Property ParamType: TParamType read FParamType write FParamType;
  831.          Property Text:String read GetAsString write SetText;
  832.          Property Value: Variant read GetAsVariant write SetAsVariant;
  833.     End;
  834.  
  835.     TParams=Class
  836.       Private
  837.          FItems: TList;
  838.          Function GetParam(Index: Word): TParam;
  839.          Function GetParamValue(Const ParamName:String):Variant;
  840.          Procedure SetParamValue(Const ParamName:String;Const Value: Variant);
  841.       Public
  842.          Constructor Create;Virtual;
  843.          Destructor Destroy;Override;
  844.          Procedure AddParam(Value: TParam);
  845.          Procedure RemoveParam(Value: TParam);
  846.          Function CreateParam(FldType:TFieldType;Const ParamName:String;ParamType: TParamType): TParam;
  847.          Function Count:LongInt;
  848.          Procedure Clear;
  849.          Function IsEqual(Value:TParams): Boolean;
  850.          Function ParamByName(Const Value:String): TParam;
  851.          Property Items[Index: Word]: TParam read GetParam;default;
  852.          Property ParamValues[Const ParamName:String]: Variant read GetParamValue write SetParamValue;
  853.     End;
  854.  
  855.     TStoredProc=Class(TTable)
  856.       Private
  857.          FPrepared:Boolean;
  858.          FParams:TParams;
  859.          FProcName:String;
  860.          Function GetParamCount:Word;
  861.          Procedure SetPrepared(NewValue:Boolean);
  862.          Procedure SetParams(NewValue:TParams);
  863.          Procedure SetStoredProcName(NewValue:String);
  864.          Property TableName;
  865.          Property MasterSource;
  866.          Property MasterFields;
  867.          Property ReadOnly;
  868.       Protected
  869.          Procedure Loaded;Override;
  870.          Procedure DoOpen;Override;
  871.          Procedure DoClose;Override;
  872.          Function UpdateFieldSelect(field:TField):Boolean;Override;
  873.       Public
  874.          Constructor Create(AOwner: TComponent);Override;
  875.          Destructor Destroy;Override;
  876.          Procedure Insert;Override;
  877.          Procedure Delete;Override;
  878.          Procedure InsertRecord(Const Values:Array Of Const);Override;
  879.          Procedure CopyParams(Value:TParams);
  880.          Procedure ExecProc;
  881.          Function ParamByName(Const Value:String):TParam;
  882.          Procedure Prepare;
  883.          Procedure UnPrepare;
  884.          Procedure SetDefaultParams;
  885.          Property ParamCount:Word read GetParamCount;
  886.          Property StmtHandle:SQLHStmt read FDBProcs.ahstmt;
  887.          Property Prepared: Boolean read FPrepared write SetPrepared;
  888.          Property Params:TParams read FParams write SetParams;
  889.        Published
  890.          Property StoredProcName:String read FProcName write SetStoredProcName;
  891.     End;
  892.  
  893.  
  894. Function Field2String(field:TField):String;
  895. Function ExtractFieldName(Const Fields:String;Var Pos:LongInt):String;
  896.  
  897. Procedure DatabaseError(Const Message:String);
  898. Procedure SQLError(Const Message:String);
  899.  
  900.  
  901.  
  902. Implementation
  903.  
  904. Type
  905.     TGraphicHeader=Record
  906.       Count:Word;                { Fixed at 1 }
  907.       HType:Word;                { Fixed at $0100 }
  908.       Size:Longint;              { Size not including header }
  909.     End;
  910.  
  911. Const SQLProcessCount:LongWord=0;
  912.  
  913. Procedure EnterSQLProcessing;
  914. Begin
  915.      Screen.Cursor:=crSQLWait;
  916.      inc(SQLProcessCount);
  917. End;
  918.  
  919. Procedure LeaveSQLProcessing;
  920. Begin
  921.      If SQLProcessCount>0 Then dec(SQLProcessCount);
  922.      If SQLProcessCount=0 Then Screen.Cursor:=crDefault;
  923. End;
  924.  
  925. Procedure DatabaseError(Const Message:String);
  926. Begin
  927.      SQLProcessCount:=0;
  928.      LeaveSQLProcessing;
  929.      Raise EDataBaseError.Create(Message);
  930. End;
  931.  
  932. Procedure SQLError(Const Message:String);
  933. Begin
  934.      SQLProcessCount:=0;
  935.      LeaveSQLProcessing;
  936.      Raise ESQLError.Create(Message);
  937. End;
  938.  
  939. {
  940. ╔═══════════════════════════════════════════════════════════════════════════╗
  941. ║                                                                           ║
  942. ║ Speed-Pascal/2 Version 2.0                                                ║
  943. ║                                                                           ║
  944. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  945. ║                                                                           ║
  946. ║ This section: TDataLink Class Implementation                              ║
  947. ║                                                                           ║
  948. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  949. ║                                                                           ║
  950. ╚═══════════════════════════════════════════════════════════════════════════╝
  951. }
  952.  
  953. Procedure TDataLink.SetDataSource(NewValue:TDataSource);
  954. Begin
  955.      If NewValue=FDataSource Then Exit;
  956.      If FDataSource<>Nil Then FDataSource.Notification(Self,opRemove);
  957.      FDataSource:=NewValue;
  958.      If FDataSource<>Nil Then FDataSource.FreeNotification(Self);
  959.      DataChange(deDataBaseChanged);
  960. End;
  961.  
  962. Procedure TDataLink.DataChange(event:TDataChange);
  963. Begin
  964.      If OnDataChange<>Nil Then OnDataChange(Self,event);
  965. End;
  966.  
  967. Procedure TDataLink.Notification(AComponent:TComponent;Operation:TOperation);
  968. Begin
  969.      Inherited Notification(AComponent,Operation);
  970.  
  971.      If AComponent=TComponent(FDataSource) Then If Operation=opRemove Then
  972.      Begin
  973.           FDataSource:=Nil;
  974.           DataChange(deDataBaseChanged);
  975.      End;
  976. End;
  977.  
  978. Destructor TDataLink.Destroy;
  979. Begin
  980.      If FDataSource<>Nil Then FDataSource.Notification(Self,opRemove);
  981.      FDataSource:=Nil;
  982.      DataChange(deDataBaseChanged);
  983.      Inherited Destroy;
  984. End;
  985.  
  986. Procedure TDataLink.SetupComponent;
  987. Begin
  988.      Inherited SetupComponent;
  989.  
  990.      Name:='DataLink';
  991.      If Owner<>Nil Then SetDesigning(Owner.Designed);
  992. End;
  993.  
  994. {
  995. ╔═══════════════════════════════════════════════════════════════════════════╗
  996. ║                                                                           ║
  997. ║ Speed-Pascal/2 Version 2.0                                                ║
  998. ║                                                                           ║
  999. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1000. ║                                                                           ║
  1001. ║ This section: TTableDataLink Class Implementation                         ║
  1002. ║                                                                           ║
  1003. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1004. ║                                                                           ║
  1005. ╚═══════════════════════════════════════════════════════════════════════════╝
  1006. }
  1007.  
  1008. Function TTableDataLink.GetColRowField(Col,Row:LongInt):TField;
  1009. Begin
  1010.      Result:=Nil;
  1011.      If ((FDataSource=Nil)Or(FDataSource.DataSet=Nil)) Then Exit;
  1012.      Result:=FDataSource.DataSet.GetResultColRow(Col,Row);
  1013. End;
  1014.  
  1015. Function TTableDataLink.GetNameRowField(Name:String;Row:LongInt):TField;
  1016. Var Col:LongInt;
  1017.     S:String;
  1018.     T:LongInt;
  1019. Label Ok;
  1020. Begin
  1021.      Result:=Nil;
  1022.      If ((FDataSource=Nil)Or(FDataSource.DataSet=Nil)) Then Exit;
  1023.  
  1024.      UpcaseStr(Name);
  1025.      For T:=0 To FDataSource.DataSet.FieldCount-1 Do
  1026.      Begin
  1027.           S:=FDataSource.DataSet.FieldNames[T];
  1028.           UpcaseStr(S);
  1029.           If S=Name Then
  1030.           Begin
  1031.                Col:=T;
  1032.                Goto Ok;
  1033.           End;
  1034.      End;
  1035.      Exit;
  1036. Ok:
  1037.      Result:=FDataSource.DataSet.GetResultColRow(Col,Row);
  1038. End;
  1039.  
  1040. Procedure TTableDataLink.SetupComponent;
  1041. Begin
  1042.      Inherited SetupComponent;
  1043.      Name:='TableDataLink';
  1044. End;
  1045.  
  1046. Function TTableDataLink.GetFieldCount:LongInt;
  1047. Begin
  1048.      Result:=0;
  1049.      If ((FDataSource=Nil)Or(FDataSource.DataSet=Nil)) Then Exit;
  1050.      Result:=FDataSource.DataSet.FieldCount;
  1051. End;
  1052.  
  1053. Function TTableDataLink.GetFieldName(Index:LongInt):String;
  1054. Begin
  1055.      Result:='';
  1056.      If ((FDataSource=Nil)Or(FDataSource.DataSet=Nil)) Then Exit;
  1057.      Result:=FDataSource.DataSet.FieldNames[Index];
  1058. End;
  1059.  
  1060. {
  1061. ╔═══════════════════════════════════════════════════════════════════════════╗
  1062. ║                                                                           ║
  1063. ║ Speed-Pascal/2 Version 2.0                                                ║
  1064. ║                                                                           ║
  1065. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1066. ║                                                                           ║
  1067. ║ This section: TFieldDataLink Class Implementation                         ║
  1068. ║                                                                           ║
  1069. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1070. ║                                                                           ║
  1071. ╚═══════════════════════════════════════════════════════════════════════════╝
  1072. }
  1073.  
  1074. Procedure TFieldDataLink.SetFieldName(Const NewValue:String);
  1075. Begin
  1076.      If GetFieldName=NewValue Then exit;
  1077.  
  1078.      AssignStr(FFieldName,NewValue);
  1079.      DataChange(deDataBaseChanged);
  1080. End;
  1081.  
  1082. Function TFieldDataLink.GetFieldName:String;
  1083. Begin
  1084.      Result:=FFieldName^;
  1085. End;
  1086.  
  1087. Procedure TFieldDataLink.SetupComponent;
  1088. Begin
  1089.      AssignStr(FFieldName,'');
  1090.  
  1091.      Inherited SetupComponent;
  1092.  
  1093.      Name:='FieldDataLink';
  1094. End;
  1095.  
  1096. Function TFieldDataLink.GetField:TField;
  1097. Var T:LongInt;
  1098.     S,s1:String;
  1099. Begin
  1100.      Result:=Nil;
  1101.      S:=GetFieldName;
  1102.      If ((FDataSource=Nil)Or(FDataSource.DataSet=Nil)Or(S='')) Then Exit;
  1103.      UpcaseStr(S);
  1104.      For T:=0 To FDataSource.DataSet.FieldCount-1 Do
  1105.      Begin
  1106.           s1:=FDataSource.DataSet.FieldNames[T];
  1107.           UpcaseStr(s1);
  1108.           If S=s1 Then
  1109.           Begin
  1110.                Result:=FDataSource.DataSet.Fields[T];
  1111.                Exit;
  1112.           End;
  1113.      End;
  1114. End;
  1115.  
  1116. Destructor TFieldDataLink.Destroy;
  1117. Begin
  1118.      AssignStr(FFieldName,'');
  1119.  
  1120.      Inherited Destroy;
  1121. End;
  1122.  
  1123. {
  1124. ╔═══════════════════════════════════════════════════════════════════════════╗
  1125. ║                                                                           ║
  1126. ║ Speed-Pascal/2 Version 2.0                                                ║
  1127. ║                                                                           ║
  1128. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1129. ║                                                                           ║
  1130. ║ This section: TDataSource Class Implementation                            ║
  1131. ║                                                                           ║
  1132. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1133. ║                                                                           ║
  1134. ╚═══════════════════════════════════════════════════════════════════════════╝
  1135. }
  1136.  
  1137. //This tables DataSource changes, notify All Servants linked With MasterSource
  1138. Procedure NotifyServants(Table:TTable);
  1139. Var T:LongInt;
  1140.     Servant:TTable;
  1141. Begin
  1142.      If Table.FServants<>Nil Then
  1143.      Begin
  1144.           //notify All Servants that their MasterSource Is invalid
  1145.           For T:=0 To Table.FServants.Count-1 Do
  1146.           Begin
  1147.                Servant:=Table.FServants[T];
  1148.                Servant.FMasterSource:=Nil;
  1149.                If ((Servant.ComponentState*[csReading]=[])And(Not Servant.FDataSetLocked)) Then
  1150.                   Servant.RefreshTable;
  1151.           End;
  1152.           Table.FServants.Clear;
  1153.      End;
  1154. End;
  1155.  
  1156. Procedure TDataSource.SetDataSet(NewValue:TDataSet);
  1157. Var Table,Servant:TTable;
  1158.     T:LongInt;
  1159. Begin
  1160.      If FDataSet<>Nil Then
  1161.      Begin
  1162.           If FDataSet Is TTable Then
  1163.           Begin
  1164.                If Not (NewValue Is TTable) Then NotifyServants(TTable(FDataSet))
  1165.                Else If NewValue<>FDataSet Then
  1166.                Begin
  1167.                     //New DataSet Is also A Table
  1168.                     //Link All Servants Of  This Table To the New one
  1169.                     Table:=TTable(FDataSet);
  1170.                     If Table.FServants<>Nil Then
  1171.                     Begin
  1172.                          For T:=0 To Table.FServants.Count-1 Do
  1173.                          Begin
  1174.                               Servant:=Table.FServants[T];
  1175.                               TTable(NewValue).ConnectServant(Servant,True);
  1176.                          End;
  1177.                          Table.FServants.Clear;
  1178.                     End;
  1179.                End;
  1180.           End;
  1181.  
  1182.           FDataSet.Notification(Self,opRemove);
  1183.      End;
  1184.      FDataSet:=NewValue;
  1185.      If FDataSet<>Nil Then FDataSet.FreeNotification(Self);
  1186.      DataChange(deDataBaseChanged);
  1187. End;
  1188.  
  1189. Destructor TDataSource.Destroy;
  1190. Begin
  1191.      If FDataSet Is TTable Then NotifyServants(TTable(FDataSet));
  1192.      If FDataSet<>Nil Then FDataSet.Notification(Self,opRemove);
  1193.      FDataSet:=Nil;
  1194.      Inherited Destroy;
  1195. End;
  1196.  
  1197. Procedure TDataSource.SetupComponent;
  1198. Begin
  1199.      Include(ComponentState, csHandleLinks);
  1200.      Inherited SetupComponent;
  1201.  
  1202. //     Include(DesignerState,dsDetail);
  1203.      Name:='DataSource';
  1204. End;
  1205.  
  1206. Procedure TDataSource.DataChange(event:TDataChange);
  1207. Var T:LongInt;
  1208.     Link:TDataLink;
  1209.     FLinkList:TList;
  1210. Begin
  1211.      FLinkList:=FreeNotifyList;
  1212.      If FLinkList<>Nil Then For T:=0 To FLinkList.Count-1 Do
  1213.      Begin
  1214.           Link:=FLinkList.Items[T];
  1215.           If Link Is TDataLink Then Link.DataChange(event);
  1216.      End;
  1217. End;
  1218.  
  1219. Procedure TDataSource.Notification(AComponent:TComponent;Operation:TOperation);
  1220. Begin
  1221.      Inherited Notification(AComponent,Operation);
  1222.  
  1223.      If AComponent=TComponent(FDataSet) Then If Operation=opRemove Then
  1224.      Begin
  1225.           FDataSet:=Nil;
  1226.           DataChange(deDataBaseChanged);
  1227.           If OnDataChange<>Nil Then OnDataChange(Self,deDataBaseChanged);
  1228.      End;
  1229. End;
  1230.  
  1231. {
  1232. ╔═══════════════════════════════════════════════════════════════════════════╗
  1233. ║                                                                           ║
  1234. ║ Speed-Pascal/2 Version 2.0                                                ║
  1235. ║                                                                           ║
  1236. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1237. ║                                                                           ║
  1238. ║ This section: TField Class Implementation                                 ║
  1239. ║                                                                           ║
  1240. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1241. ║                                                                           ║
  1242. ╚═══════════════════════════════════════════════════════════════════════════╝
  1243. }
  1244.  
  1245. Function TField.GetIsIndexField:Boolean;
  1246. Var s,s1,s2:String;
  1247.     t:LongInt;
  1248.     IndexDef:TIndexDef;
  1249. Begin
  1250.      Result:=False;
  1251.      If not (FDataSet Is TTable) Then exit;
  1252.      s:=FieldName;
  1253.      UpcaseStr(s);
  1254.      For t:=0 To TTable(FDataSet).IndexDefs.Count-1 Do
  1255.      Begin
  1256.           IndexDef:=TTable(FDataSet).IndexDefs[t];
  1257.           s1:=IndexDef.Fields;
  1258.           UpcaseStr(s1);
  1259.           While pos(';',s1)<>0 Do
  1260.           Begin
  1261.                s2:=Copy(s1,1,pos(';',s1)-1);
  1262.                Delete(s1,1,pos(';',s1));
  1263.                If s=s2 Then
  1264.                Begin
  1265.                    Result:=True;
  1266.                    exit;
  1267.                End;
  1268.           End;
  1269.           If s=s1 Then Result:=True;
  1270.      End;
  1271. End;
  1272.  
  1273. Function TField.GetReadOnly:Boolean;
  1274. Begin
  1275.      Result:=FReadOnly Or FDataSet.ReadOnly;
  1276. End;
  1277.  
  1278. Function TField.GetCanModify:Boolean;
  1279. Begin
  1280.      Result:=not ReadOnly;
  1281. End;
  1282.  
  1283. Procedure TField.SetData(Buffer:Pointer);
  1284. Begin
  1285.      If ReadOnly Then DataBaseError('Cannot modify a readonly field !');
  1286.  
  1287.      If FValueLen > 0 Then
  1288.      Begin
  1289.           If FValue<>Nil Then FreeMem(FValue,FValueLen);
  1290.           FValue:=Nil;
  1291.           If Buffer<>Nil Then
  1292.           Begin
  1293.              GetMem(FValue,FValueLen);
  1294.              Move(Buffer^,FValue^,FValueLen);
  1295.           End;
  1296.      End;
  1297. End;
  1298.  
  1299. Procedure TField.Assign(Field:TField);
  1300. Begin
  1301.      If ReadOnly Then DataBaseError('Cannot modify a readonly field !');
  1302.  
  1303.      If Field=Nil Then
  1304.      Begin
  1305.           Clear;
  1306.           If FValueLen<>0 Then FreeMem(FValue,FValueLen);
  1307.           FValueLen:=0;
  1308.           FValue:=Nil;
  1309.           exit;
  1310.      End;
  1311.  
  1312.      Value:=Field.Value;
  1313. End;
  1314.  
  1315. Function TField.GetAsVariant:Variant;
  1316. Begin
  1317.      AccessError('Variant');
  1318. End;
  1319.  
  1320. Procedure TField.SetAsVariant(NewValue:Variant);
  1321. Begin
  1322.      AccessError('Variant');
  1323. End;
  1324.  
  1325. Function TField.GetFieldName:String;
  1326. Begin
  1327.      If FFieldDef <> Nil Then Result := FFieldDef.Name
  1328.      Else Result:='';
  1329. End;
  1330.  
  1331. Function TField.GetIsNull:Boolean;
  1332. Begin
  1333.      Result:=FValue=Nil;
  1334. End;
  1335.  
  1336. Destructor TField.Destroy;
  1337. Begin
  1338.      If FValue<>Nil Then
  1339.        If FValueLen>0 Then FreeMem(FValue,FValueLen);
  1340.      FValueLen:=0;
  1341.      FValue:=Nil;
  1342.  
  1343.      Inherited Destroy;
  1344. End;
  1345.  
  1346. Procedure TField.Clear;
  1347. Var  OldValue:Pointer;
  1348.      OldValueLen:LongInt;
  1349. Begin
  1350.      //SetNewValue(Nil,0);
  1351.  
  1352.      OldValue := FValue;
  1353.      OldValueLen := FValueLen;
  1354.      FValueLen := 0;
  1355.      FValue := Nil;
  1356.      FDataSet.UpdateField(Self,OldValue,OldValueLen);
  1357.      {wo wird der alte Speicher wieder freigegeben???}
  1358. End;
  1359.  
  1360.  
  1361. Procedure TField.FreeMemory;
  1362. Begin
  1363.      If (FValue <> Nil) And (FValueLen > 0) Then FreeMem(FValue,FValueLen);
  1364.      FValueLen := 0;
  1365.      FValue := Nil;
  1366. End;
  1367.  
  1368. Procedure TField.GetMemory(Size:Longint);
  1369. Begin
  1370.      FValueLen := Size;
  1371.      GetMem(FValue,FValueLen);
  1372. End;
  1373.  
  1374.  
  1375. Procedure TField.AccessError(Const TypeName:String);
  1376. Begin
  1377.      DatabaseError('Invalid type conversion to '+TypeName+' in field: '+FieldName);
  1378. End;
  1379.  
  1380.  
  1381. Procedure TField.CheckInactive;
  1382. Begin
  1383.      If FDataSet <> Nil Then FDataSet.CheckInactive;
  1384. End;
  1385.  
  1386.  
  1387. {$HINTS OFF}
  1388. Procedure TField.SetAsValue(Var Value;Len:LongInt);
  1389. Begin
  1390.      SetNewValue(Value,Len);
  1391. End;
  1392.  
  1393. Function TField.GetAsString:String;
  1394. Begin
  1395.      AccessError('String');
  1396. End;
  1397.  
  1398. Procedure TField.SetAsString(Const NewValue:String);
  1399. Begin
  1400.      AccessError('String');
  1401. End;
  1402.  
  1403. Function TField.GetAsAnsiString:AnsiString;
  1404. Begin
  1405.      AccessError('AnsiString');
  1406. End;
  1407.  
  1408. Procedure TField.SetAsAnsiString(NewValue:AnsiString);
  1409. Begin
  1410.      AccessError('AnsiString');
  1411. End;
  1412.  
  1413. Function TField.GetAsBoolean:Boolean;
  1414. Begin
  1415.      AccessError('Boolean');
  1416. End;
  1417.  
  1418. Procedure TField.SetAsBoolean(NewValue:Boolean);
  1419. Begin
  1420.      AccessError('Boolean');
  1421. End;
  1422.  
  1423. Function TField.GetAsDateTime:TDateTime;
  1424. Begin
  1425.      AccessError('DateTime');
  1426. End;
  1427.  
  1428. Procedure TField.SetAsDateTime(NewValue:TDateTime);
  1429. Begin
  1430.      AccessError('DateTime');
  1431. End;
  1432.  
  1433. Function TField.GetAsFloat:Extended;
  1434. Begin
  1435.      AccessError('Float');
  1436. End;
  1437.  
  1438. Procedure TField.SetAsFloat(Const NewValue:Extended);
  1439. Begin
  1440.      AccessError('Float');
  1441. End;
  1442.  
  1443. Function TField.GetAsInteger:LongInt;
  1444. Begin
  1445.      AccessError('Integer');
  1446. End;
  1447.  
  1448. Procedure TField.SetAsInteger(NewValue:LongInt);
  1449. Begin
  1450.      AccessError('Integer');
  1451. End;
  1452. {$HINTS ON}
  1453.  
  1454. Procedure TField.SetNewValue(Var NewValue;NewLen:LongInt);
  1455. Var OldValue:Pointer;
  1456.     OldValueLen:LongInt;
  1457. Begin
  1458.      If ReadOnly Then DataBaseError('Cannot modify a readonly field !');
  1459.  
  1460.      OldValue:=FValue;
  1461.      OldValueLen:=FValueLen;
  1462.      FValueLen:=NewLen;
  1463.      If FValueLen > 0 Then
  1464.      Begin
  1465.           GetMem(FValue,FValueLen);
  1466.           Move(NewValue,FValue^,FValueLen);
  1467.      End;
  1468.      FDataSet.UpdateField(Self,OldValue,OldValueLen);
  1469.      {wo wird der alte Speicher wieder freigegeben???}
  1470. End;
  1471.  
  1472. {
  1473. ╔═══════════════════════════════════════════════════════════════════════════╗
  1474. ║                                                                           ║
  1475. ║ Speed-Pascal/2 Version 2.0                                                ║
  1476. ║                                                                           ║
  1477. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1478. ║                                                                           ║
  1479. ║ This section: TStringField Class Implementation                           ║
  1480. ║                                                                           ║
  1481. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1482. ║                                                                           ║
  1483. ╚═══════════════════════════════════════════════════════════════════════════╝
  1484. }
  1485.  
  1486. Function TStringField.GetAsVariant:Variant;
  1487. Begin
  1488.      Result:=GetAsString;
  1489. End;
  1490.  
  1491. Procedure TStringField.SetAsVariant(NewValue:Variant);
  1492. Begin
  1493.      SetAsString(NewValue);
  1494. End;
  1495.  
  1496. Function TStringField.GetAsString:String;
  1497. Begin
  1498.      If FValue <> Nil Then
  1499.      Begin
  1500.           Result[0] := Chr(FValueLen);
  1501.           Move(FValue^,Result[1],Ord(Result[0]));
  1502.           If Result[Length(Result)]=#0 Then
  1503.             If length(Result)>0 Then Dec(Result[0]);
  1504.      End
  1505.      //Else Result:='NULL';
  1506.      Else Result := '';
  1507. End;
  1508.  
  1509. Procedure TStringField.SetAsString(Const NewValue:String);
  1510. Var C:CString;
  1511. Begin
  1512.      If NewValue <> '' Then
  1513.      Begin
  1514.           C:=NewValue;
  1515.           SetNewValue(C,Length(NewValue)+1);
  1516.      End
  1517.      Else Clear;
  1518. End;
  1519.  
  1520. Function TStringField.GetAsAnsiString:AnsiString;
  1521. Begin
  1522.      If FValue<>Nil Then Result:=PChar(Value)^
  1523.      Else Result:='';
  1524. End;
  1525.  
  1526. Procedure TStringField.SetAsAnsiString(NewValue:AnsiString);
  1527. Begin
  1528.      If PChar(NewValue) = Nil Then NewValue:=#0;
  1529.      SetNewValue(PChar(NewValue)^,length(PChar(NewValue)^)+1)
  1530. End;
  1531.  
  1532. Function TStringField.GetAsBoolean:Boolean;
  1533. Var S:String;
  1534. Begin
  1535.      S:=GetAsString;
  1536.      UpcaseStr(S);
  1537.      If ((S='TRUE')Or(S='YES')Or(S='1')) Then Result:=True
  1538.      Else Result:=False
  1539. End;
  1540.  
  1541. Procedure TStringField.SetAsBoolean(NewValue:Boolean);
  1542. Var S:String;
  1543. Begin
  1544.      If NewValue Then S:='True'
  1545.      Else S:='False';
  1546.      SetAsString(S);
  1547. End;
  1548.  
  1549. Function TStringField.GetAsDateTime:TDateTime;
  1550. Begin
  1551.      Result:=StrToDateTime(GetAsString);
  1552. End;
  1553.  
  1554. Function TStringField.GetAsFloat:Extended;
  1555. Begin
  1556.      Result:=StrToFloat(GetAsString);
  1557. End;
  1558.  
  1559. Procedure TStringField.SetAsFloat(Const NewValue:Extended);
  1560. Begin
  1561.      SetAsString(FloatToStr(NewValue));
  1562. End;
  1563.  
  1564. Function TStringField.GetAsInteger:LongInt;
  1565. Begin
  1566.      Result:=StrToInt(GetAsString);
  1567. End;
  1568.  
  1569. Procedure TStringField.SetAsInteger(NewValue:LongInt);
  1570. Begin
  1571.      SetAsString(tostr(NewValue));
  1572. End;
  1573.  
  1574. {
  1575. ╔═══════════════════════════════════════════════════════════════════════════╗
  1576. ║                                                                           ║
  1577. ║ Speed-Pascal/2 Version 2.0                                                ║
  1578. ║                                                                           ║
  1579. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1580. ║                                                                           ║
  1581. ║ This section: TSmallintField Class Implementation                         ║
  1582. ║                                                                           ║
  1583. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1584. ║                                                                           ║
  1585. ╚═══════════════════════════════════════════════════════════════════════════╝
  1586. }
  1587.  
  1588. Function TSmallIntField.GetAsVariant:Variant;
  1589. Begin
  1590.      Result:=GetAsSmallInt;
  1591. End;
  1592.  
  1593. Procedure TSmallIntField.SetAsVariant(NewValue:Variant);
  1594. Begin
  1595.      SetAsSmallInt(NewValue);
  1596. End;
  1597.  
  1598.  
  1599. Function TSmallintField.GetAsString:String;
  1600. Begin
  1601.      If FValue<>Nil Then Result:=tostr(Integer(FValue^))
  1602.      Else Result:='';
  1603. End;
  1604.  
  1605. Procedure TSmallintField.SetAsString(Const NewValue:String);
  1606. Var I,C:Integer;
  1607. Begin
  1608.      If NewValue <> '' Then
  1609.      Begin
  1610.           Val(NewValue,I,C);
  1611.           If C=0 Then SetNewValue(I,SizeOf(Integer));
  1612.      End
  1613.      Else Clear;
  1614. End;
  1615.  
  1616. Function TSmallintField.GetAsAnsiString:AnsiString;
  1617. Begin
  1618.     Result:=GetAsString;
  1619. End;
  1620.  
  1621. Procedure TSmallintField.SetAsAnsiString(NewValue:AnsiString);
  1622. Begin
  1623.     SetAsString(NewValue);
  1624. End;
  1625.  
  1626. Function TSmallintField.GetAsBoolean:Boolean;
  1627. Var I:Integer;
  1628. Begin
  1629.      I:=GetAsInteger;
  1630.      Result:=I<>0;
  1631. End;
  1632.  
  1633. Procedure TSmallintField.SetAsBoolean(NewValue:Boolean);
  1634. Begin
  1635.      If NewValue Then SetAsInteger(1)
  1636.      Else SetAsInteger(0);
  1637. End;
  1638.  
  1639. Function TSmallintField.GetAsSmallint:Integer;
  1640. Begin
  1641.      If FValue<>Nil Then Result:=Integer(FValue^)
  1642.      Else AccessError('Smallint');
  1643. End;
  1644.  
  1645. Procedure TSmallintField.SetAsSmallInt(NewValue:Integer);
  1646. Begin
  1647.      SetNewValue(NewValue,SizeOf(Integer));
  1648. End;
  1649.  
  1650. Function TSmallintField.GetAsFloat:Extended;
  1651. Begin
  1652.      If FValue<>Nil Then Result:=Integer(FValue^)
  1653.      Else AccessError('Float');
  1654. End;
  1655.  
  1656. Procedure TSmallintField.SetAsFloat(Const NewValue:Extended);
  1657. Begin
  1658.      SetAsSmallInt(Round(NewValue));
  1659. End;
  1660.  
  1661. Function TSmallintField.GetAsInteger:LongInt;
  1662. Begin
  1663.      If FValue<>Nil Then Result:=Integer(FValue^)
  1664.      Else AccessError('Integer');
  1665. End;
  1666.  
  1667. Procedure TSmallintField.SetAsInteger(NewValue:LongInt);
  1668. Begin
  1669.      SetAsSmallInt(NewValue);
  1670. End;
  1671.  
  1672. {
  1673. ╔═══════════════════════════════════════════════════════════════════════════╗
  1674. ║                                                                           ║
  1675. ║ Speed-Pascal/2 Version 2.0                                                ║
  1676. ║                                                                           ║
  1677. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1678. ║                                                                           ║
  1679. ║ This section: TIntegerField Class Implementation                          ║
  1680. ║                                                                           ║
  1681. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1682. ║                                                                           ║
  1683. ╚═══════════════════════════════════════════════════════════════════════════╝
  1684. }
  1685.  
  1686.  
  1687. Function TIntegerField.GetAsVariant:Variant;
  1688. Begin
  1689.      Result:=GetAsInteger;
  1690. End;
  1691.  
  1692. Procedure TIntegerField.SetAsVariant(NewValue:Variant);
  1693. Begin
  1694.      SetAsInteger(NewValue);
  1695. End;
  1696.  
  1697. Function TIntegerField.GetAsString:String;
  1698. Begin
  1699.      If FValue<>Nil Then Result:=tostr(LongInt(FValue^))
  1700.      Else Result:='';
  1701. End;
  1702.  
  1703. Procedure TIntegerField.SetAsString(Const NewValue:String);
  1704. Var I:LongInt;
  1705.     C:Integer;
  1706. Begin
  1707.      If NewValue <> '' Then
  1708.      Begin
  1709.           Val(NewValue,I,C);
  1710.           If C=0 Then SetNewValue(I,SizeOf(LongInt))
  1711.           Else AccessError('String');
  1712.      End
  1713.      Else Clear;
  1714. End;
  1715.  
  1716. Function TIntegerField.GetAsAnsiString:AnsiString;
  1717. Begin
  1718.    Result:=GetAsString;
  1719. End;
  1720.  
  1721. Procedure TIntegerField.SetAsAnsiString(NewValue:AnsiString);
  1722. Begin
  1723.    SetAsString(NewValue);
  1724. End;
  1725.  
  1726. Function TIntegerField.GetAsBoolean:Boolean;
  1727. Var I:Integer;
  1728. Begin
  1729.      I:=GetAsInteger;
  1730.      Result:=I<>0;
  1731. End;
  1732.  
  1733. Procedure TIntegerField.SetAsBoolean(NewValue:Boolean);
  1734. Begin
  1735.      If NewValue Then SetAsInteger(1)
  1736.      Else SetAsInteger(0);
  1737. End;
  1738.  
  1739. Function TIntegerField.GetAsFloat:Extended;
  1740. Begin
  1741.      If FValue<>Nil Then Result:=LongInt(FValue^)
  1742.      Else AccessError('Float');
  1743. End;
  1744.  
  1745. Procedure TIntegerField.SetAsFloat(Const NewValue:Extended);
  1746. Begin
  1747.      SetAsInteger(Round(NewValue));
  1748. End;
  1749.  
  1750. Function TIntegerField.GetAsInteger:LongInt;
  1751. Begin
  1752.      If FValue<>Nil Then Result:=LongInt(FValue^)
  1753.      Else AccessError('Integer');
  1754. End;
  1755.  
  1756. Procedure TIntegerField.SetAsInteger(NewValue:LongInt);
  1757. Begin
  1758.      SetNewValue(NewValue,SizeOf(LongInt));
  1759. End;
  1760.  
  1761. {
  1762. ╔═══════════════════════════════════════════════════════════════════════════╗
  1763. ║                                                                           ║
  1764. ║ Speed-Pascal/2 Version 2.0                                                ║
  1765. ║                                                                           ║
  1766. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1767. ║                                                                           ║
  1768. ║ This section: TBooleanField Class Implementation                          ║
  1769. ║                                                                           ║
  1770. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1771. ║                                                                           ║
  1772. ╚═══════════════════════════════════════════════════════════════════════════╝
  1773. }
  1774.  
  1775. Function TBooleanField.GetAsVariant:Variant;
  1776. Begin
  1777.      Result:=GetAsBoolean;
  1778. End;
  1779.  
  1780. Procedure TBooleanField.SetAsVariant(NewValue:Variant);
  1781. Begin
  1782.      SetAsBoolean(NewValue);
  1783. End;
  1784.  
  1785.  
  1786. Function TBooleanField.GetAsString:String;
  1787. Begin
  1788.      If FValue<>Nil Then
  1789.      Begin
  1790.           If Boolean(FValue^) Then Result:='True'
  1791.           Else Result:='False';
  1792.      End
  1793.      Else Result:='';
  1794. End;
  1795.  
  1796. Procedure TBooleanField.SetAsString(Const NewValue:String);
  1797. Var  s:String;
  1798. Begin
  1799.      If NewValue <> '' Then
  1800.      Begin
  1801.           s:=NewValue;
  1802.           UpcaseStr(s);
  1803.  
  1804.           If ((s='TRUE')Or(s='YES')Or(s='T')Or(s='Y')Or(s='1')) Then SetAsBoolean(True)
  1805.           Else SetAsBoolean(False);
  1806.      End
  1807.      Else Clear;
  1808. End;
  1809.  
  1810. Function TBooleanField.GetAsAnsiString:AnsiString;
  1811. Begin
  1812.      Result:=GetAsString;
  1813. End;
  1814.  
  1815. Procedure TBooleanField.SetAsAnsiString(NewValue:AnsiString);
  1816. Begin
  1817.      SetAsString(NewValue);
  1818. End;
  1819.  
  1820. Function TBooleanField.GetAsBoolean:Boolean;
  1821. Begin
  1822.      If FValue<>Nil Then
  1823.      Begin
  1824.           Result := Boolean(FValue^);
  1825.      End
  1826.      Else Result:=False;
  1827. End;
  1828.  
  1829. Procedure TBooleanField.SetAsBoolean(NewValue:Boolean);
  1830. Begin
  1831.      SetNewValue(NewValue,SizeOf(Boolean))
  1832. End;
  1833.  
  1834. Function TBooleanField.GetAsFloat:Extended;
  1835. Begin
  1836.      If FValue<>Nil Then
  1837.      Begin
  1838.           If Boolean(FValue^) Then Result := 1
  1839.           Else Result := 0;
  1840.      End
  1841.      Else AccessError('Float');
  1842. End;
  1843.  
  1844. Procedure TBooleanField.SetAsFloat(Const NewValue:Extended);
  1845. Begin
  1846.      SetAsInteger(round(NewValue));
  1847. End;
  1848.  
  1849. Function TBooleanField.GetAsInteger:LongInt;
  1850. Begin
  1851.      If FValue<>Nil Then
  1852.      Begin
  1853.           If Boolean(FValue^) Then Result := 1
  1854.           Else Result := 0;
  1855.      End
  1856.      Else AccessError('Integer');
  1857. End;
  1858.  
  1859. Procedure TBooleanField.SetAsInteger(NewValue:LongInt);
  1860. Begin
  1861.      If NewValue = 0 Then SetAsBoolean(False)
  1862.      Else SetAsBoolean(True);
  1863. End;
  1864.  
  1865.  
  1866. {
  1867. ╔═══════════════════════════════════════════════════════════════════════════╗
  1868. ║                                                                           ║
  1869. ║ Speed-Pascal/2 Version 2.0                                                ║
  1870. ║                                                                           ║
  1871. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1872. ║                                                                           ║
  1873. ║ This section: TFloatField Class Implementation                            ║
  1874. ║                                                                           ║
  1875. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1876. ║                                                                           ║
  1877. ╚═══════════════════════════════════════════════════════════════════════════╝
  1878. }
  1879.  
  1880. Constructor TFloatField.Create;
  1881. Begin
  1882.      Inherited Create;
  1883.  
  1884.      FPrecision := -1;
  1885. End;
  1886.  
  1887. Function TFloatField.GetAsVariant:Variant;
  1888. Begin
  1889.      Result:=GetAsFloat;
  1890. End;
  1891.  
  1892. Procedure TFloatField.SetAsVariant(NewValue:Variant);
  1893. Begin
  1894.      SetAsFloat(NewValue);
  1895. End;
  1896.  
  1897.  
  1898. Procedure TFloatField.SetPrecision(Value:Longint);
  1899. Begin
  1900.      //If Value < 2 Then Value := 2;
  1901.      If Value > 15 Then Value := 15;
  1902.      FPrecision := Value;
  1903. End;
  1904.  
  1905.  
  1906. Function TFloatField.GetAsString:String;
  1907. Var  E:Extended;
  1908. Begin
  1909.      If FValue <> Nil Then
  1910.      Begin
  1911.           E := GetAsFloat;
  1912.  
  1913.           If Precision >= 0 Then
  1914.           Begin
  1915.                Result := Format('%.'+ tostr(Precision) +'f',[E]);
  1916.                If Precision = 0 Then
  1917.                  If pos('.',Result) > 0 Then SubStr(Result,1,pos('.',Result)-1);
  1918.           End
  1919.           Else Result := FloatToStr(E);
  1920.      End
  1921.      Else Result := '';
  1922. End;
  1923.  
  1924.  
  1925. Procedure TFloatField.SetAsString(Const NewValue:String);
  1926. Var E:Extended;
  1927.     C:Integer;
  1928.     p:Integer;
  1929.     aValue:String;
  1930. Begin
  1931.      If NewValue <> '' Then
  1932.      Begin
  1933.           //replace , by .
  1934.           p := pos(',',NewValue);
  1935.           If p > 0 Then
  1936.           Begin
  1937.                aValue := NewValue;
  1938.                aValue[p] := '.';
  1939.                Val(aValue,E,C);
  1940.           End
  1941.           Else Val(NewValue,E,C);
  1942.  
  1943.           If C=0 Then SetAsFloat(E)
  1944.           Else AccessError('String');
  1945.      End
  1946.      Else Clear;
  1947. End;
  1948.  
  1949.  
  1950. Function TFloatField.GetAsAnsiString:AnsiString;
  1951. Begin
  1952.      Result:=GetAsString;
  1953. End;
  1954.  
  1955. Procedure TFloatField.SetAsAnsiString(NewValue:AnsiString);
  1956. Begin
  1957.     SetAsString(NewValue);
  1958. End;
  1959.  
  1960. Function TFloatField.GetAsFloat:Extended;
  1961. Begin
  1962.      If FValue<>Nil Then
  1963.      Begin
  1964.           Case FSize Of
  1965.             4:Result:=Single(FValue^);
  1966.             8:Result:=Double(FValue^);
  1967.             10:Result:=Extended(FValue^);
  1968.             Else AccessError('Float');
  1969.           End; {Case}
  1970.      End
  1971.      //Else AccessError('Float');
  1972.      Else Result := 0;
  1973. End;
  1974.  
  1975.  
  1976. Procedure TFloatField.SetAsFloat(Const NewValue:Extended);
  1977. Var E:Extended;
  1978.     S:Single;
  1979.     D:Double;
  1980. Begin
  1981.      Case FSize Of
  1982.         4:
  1983.         Begin
  1984.              S:=NewValue;
  1985.              SetNewValue(S,SizeOf(Single));
  1986.         End;
  1987.         8:
  1988.         Begin
  1989.              D:=NewValue;
  1990.              SetNewValue(D,SizeOf(Double));
  1991.         End;
  1992.         10:
  1993.         Begin
  1994.              E:=NewValue;
  1995.              SetNewValue(E,SizeOf(Extended));
  1996.         End;
  1997.      End;
  1998. End;
  1999.  
  2000.  
  2001. Function TFloatField.GetAsInteger:LongInt;
  2002. Begin
  2003.      Result := Round(GetAsFloat);
  2004. End;
  2005.  
  2006.  
  2007. Procedure TFloatField.SetAsInteger(NewValue:LongInt);
  2008. Var  E:Extended;
  2009. Begin
  2010.      E := NewValue;
  2011.      SetAsFloat(E);
  2012. End;
  2013.  
  2014. {
  2015. ╔═══════════════════════════════════════════════════════════════════════════╗
  2016. ║                                                                           ║
  2017. ║ Speed-Pascal/2 Version 2.0                                                ║
  2018. ║                                                                           ║
  2019. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2020. ║                                                                           ║
  2021. ║ This section: TCurrencyField Class Implementation                         ║
  2022. ║                                                                           ║
  2023. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2024. ║                                                                           ║
  2025. ╚═══════════════════════════════════════════════════════════════════════════╝
  2026. }
  2027.  
  2028. Constructor TCurrencyField.Create;
  2029. Begin
  2030.      Inherited Create;
  2031.  
  2032.      FPrecision := 2;
  2033. End;
  2034.  
  2035.  
  2036. {
  2037. ╔═══════════════════════════════════════════════════════════════════════════╗
  2038. ║                                                                           ║
  2039. ║ Speed-Pascal/2 Version 2.0                                                ║
  2040. ║                                                                           ║
  2041. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2042. ║                                                                           ║
  2043. ║ This section: TDateField Class Implementation                             ║
  2044. ║                                                                           ║
  2045. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2046. ║                                                                           ║
  2047. ╚═══════════════════════════════════════════════════════════════════════════╝
  2048. }
  2049.  
  2050. Function TDateField.GetAsString:String;
  2051. Var  date:TDateTime;
  2052. Begin
  2053.      If FValue <> Nil Then
  2054.      Begin
  2055.           date := GetAsDateTime;
  2056.           DateTimeToString(result,DisplayFormat,date);
  2057.      End
  2058.      Else Result := '';
  2059. End;
  2060.  
  2061. Destructor TDateField.Destroy;
  2062. Begin
  2063.      AssignStr(FDisplayFormat,'');
  2064.      Inherited Destroy;
  2065. End;
  2066.  
  2067. Function TDateField.GetDisplayFormat:String;
  2068. Begin
  2069.      If FDisplayFormat=Nil Then Result:=ShortDateFormat
  2070.      Else Result:=FDisplayFormat^;
  2071. End;
  2072.  
  2073. Procedure TDateField.SetDisplayFormat(Const NewValue:String);
  2074. Begin
  2075.      AssignStr(FDisplayFormat,NewValue);
  2076.      If FDataSet<>Nil Then FDataSet.DataChange(deDataBaseChanged);
  2077. End;
  2078.  
  2079. Function TDateField.GetAsVariant:Variant;
  2080. Begin
  2081.      Result:=GetAsDateTime;
  2082. End;
  2083.  
  2084. Procedure TDateField.SetAsVariant(NewValue:Variant);
  2085. Begin
  2086.      SetAsDateTime(NewValue);
  2087. End;
  2088.  
  2089.  
  2090. Procedure TDateField.SetAsString(Const NewValue:String);
  2091. Var dt:TDateTime;
  2092.     Valid:Boolean;
  2093. Begin
  2094.      If NewValue <> '' Then
  2095.      Begin
  2096.           Try
  2097.              dt:=StrToDate(NewValue);
  2098.              Valid:=True;
  2099.           Except
  2100.              Valid:=False;
  2101.           End;
  2102.           If Valid Then SetAsDateTime(dt);
  2103.      End
  2104.      Else Clear;
  2105. End;
  2106.  
  2107. Function TDateField.GetAsAnsiString:AnsiString;
  2108. Begin
  2109.      Result:=GetAsString;
  2110. End;
  2111.  
  2112. Procedure TDateField.SetAsAnsiString(NewValue:AnsiString);
  2113. Begin
  2114.      SetAsString(NewValue);
  2115. End;
  2116.  
  2117. Function TDateField.GetAsFloat:Extended;
  2118. Begin
  2119.      If FValue<>Nil Then Result:=GetAsDateTime
  2120.      Else AccessError('Float');
  2121. End;
  2122.  
  2123.  
  2124. Function TDateField.GetAsDateTime:TDateTime;
  2125. Var  date:TODBCDate;
  2126. Begin
  2127.      If FValue<>Nil Then
  2128.      Begin
  2129.           date:=TODBCDate(FValue^);
  2130.           Result:=EncodeDate(date.Year,date.Month,date.Day);
  2131.      End
  2132.      Else AccessError('DateTime');
  2133. End;
  2134.  
  2135. Procedure TDateField.SetAsDateTime(NewValue:TDateTime);
  2136. Var  R:TODBCDate;
  2137. Begin
  2138.      DecodeDate(NewValue,R.Year,R.Month,R.Day);
  2139.      SetNewValue(R,SizeOf(R));
  2140. End;
  2141.  
  2142. {
  2143. ╔═══════════════════════════════════════════════════════════════════════════╗
  2144. ║                                                                           ║
  2145. ║ Speed-Pascal/2 Version 2.0                                                ║
  2146. ║                                                                           ║
  2147. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2148. ║                                                                           ║
  2149. ║ This section: TTimeField Class Implementation                             ║
  2150. ║                                                                           ║
  2151. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2152. ║                                                                           ║
  2153. ╚═══════════════════════════════════════════════════════════════════════════╝
  2154. }
  2155.  
  2156.  
  2157. Procedure RoundDecodeTime(Time: TDateTime; Var Hour, Min, Sec: Word);
  2158. Var  MSec:Word;
  2159. Begin
  2160.      DecodeTime(Time, Hour, Min, Sec, MSec);
  2161.  
  2162.      If MSec > 500 Then
  2163.      Begin
  2164.           MSec := 0;
  2165.           inc(Sec);
  2166.      End;
  2167.      If Sec >= 60 Then
  2168.      Begin
  2169.           dec(Sec,60);
  2170.           inc(Min);
  2171.      End;
  2172.      If Min >= 60 Then
  2173.      Begin
  2174.           dec(Min,60);
  2175.           inc(Hour);
  2176.      End;
  2177. End;
  2178.  
  2179.  
  2180. Destructor TTimeField.Destroy;
  2181. Begin
  2182.      AssignStr(FDisplayFormat,'');
  2183.      Inherited Destroy;
  2184. End;
  2185.  
  2186. Function TTimeField.GetDisplayFormat:String;
  2187. Begin
  2188.      If FDisplayFormat=Nil Then Result:=LongTimeFormat
  2189.      Else Result:=FDisplayFormat^;
  2190. End;
  2191.  
  2192. Procedure TTimeField.SetDisplayFormat(Const NewValue:String);
  2193. Begin
  2194.      AssignStr(FDisplayFormat,NewValue);
  2195.      If FDataSet<>Nil Then FDataSet.DataChange(deDataBaseChanged);
  2196. End;
  2197.  
  2198. Function TTimeField.GetAsVariant:Variant;
  2199. Begin
  2200.      Result:=GetAsDateTime;
  2201. End;
  2202.  
  2203. Procedure TTimeField.SetAsVariant(NewValue:Variant);
  2204. Begin
  2205.      SetAsDateTime(NewValue);
  2206. End;
  2207.  
  2208.  
  2209. Function TTimeField.GetAsString:String;
  2210. Var Time:TDateTime;
  2211. Begin
  2212.      If FValue<>Nil Then
  2213.      Begin
  2214.          Time:=GetAsDateTime;
  2215.          DateTimeToString(Result,DisplayFormat,Time);
  2216.      End
  2217.      Else Result:='';
  2218. End;
  2219.  
  2220. Procedure TTimeField.SetAsString(Const NewValue:String);
  2221. Var dt:TDateTime;
  2222.     Valid:Boolean;
  2223. Begin
  2224.      If NewValue <> '' Then
  2225.      Begin
  2226.           Try
  2227.              dt:=StrToTime(NewValue);
  2228.              Valid:=True;
  2229.           Except
  2230.              Valid:=False;
  2231.           End;
  2232.           If Valid Then SetAsDateTime(dt);
  2233.      End
  2234.      Else Clear;
  2235. End;
  2236.  
  2237. Function TTimeField.GetAsAnsiString:AnsiString;
  2238. Begin
  2239.      Result:=GetAsString;
  2240. End;
  2241.  
  2242. Procedure TTimeField.SetAsAnsiString(NewValue:AnsiString);
  2243. Begin
  2244.      SetAsString(NewValue);
  2245. End;
  2246.  
  2247. Function TTimeField.GetAsFloat:Extended;
  2248. Begin
  2249.      If FValue<>Nil Then Result:=GetAsDateTime
  2250.      Else AccessError('Float');
  2251. End;
  2252.  
  2253.  
  2254. Function TTimeField.GetAsDateTime:TDateTime;
  2255. Var  Time:TODBCTime;
  2256. Begin
  2257.      If FValue<>Nil Then
  2258.      Begin
  2259.           Time:=TODBCTime(FValue^);
  2260.           Result:=EncodeTime(Time.Hour,Time.Minute,Time.Second,0);
  2261.      End
  2262.      Else AccessError('DateTime');
  2263. End;
  2264.  
  2265. Procedure TTimeField.SetAsDateTime(NewValue:TDateTime);
  2266. Var  R:TODBCTime;
  2267. Begin
  2268.      RoundDecodeTime(NewValue,R.Hour,R.Minute,R.Second);
  2269.      SetNewValue(R,SizeOf(R));
  2270. End;
  2271.  
  2272. {
  2273. ╔═══════════════════════════════════════════════════════════════════════════╗
  2274. ║                                                                           ║
  2275. ║ Speed-Pascal/2 Version 2.0                                                ║
  2276. ║                                                                           ║
  2277. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2278. ║                                                                           ║
  2279. ║ This section: TDateTimeField Class Implementation                         ║
  2280. ║                                                                           ║
  2281. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2282. ║                                                                           ║
  2283. ╚═══════════════════════════════════════════════════════════════════════════╝
  2284. }
  2285.  
  2286.  
  2287. Destructor TDateTimeField.Destroy;
  2288. Begin
  2289.      AssignStr(FDisplayFormat,'');
  2290.      Inherited Destroy;
  2291. End;
  2292.  
  2293. Function TDateTimeField.GetDisplayFormat:String;
  2294. Begin
  2295.      If FDisplayFormat=Nil Then Result:=ShortDateFormat+' '+LongTimeFormat
  2296.      Else Result:=FDisplayFormat^;
  2297. End;
  2298.  
  2299. Procedure TDateTimeField.SetDisplayFormat(Const NewValue:String);
  2300. Begin
  2301.      AssignStr(FDisplayFormat,NewValue);
  2302.      If FDataSet<>Nil Then FDataSet.DataChange(deDataBaseChanged);
  2303. End;
  2304.  
  2305. Function TDateTimeField.GetAsVariant:Variant;
  2306. Begin
  2307.      Result:=GetAsDateTime;
  2308. End;
  2309.  
  2310. Procedure TDateTimeField.SetAsVariant(NewValue:Variant);
  2311. Begin
  2312.      SetAsDateTime(NewValue);
  2313. End;
  2314.  
  2315.  
  2316. Function TDateTimeField.GetAsString:String;
  2317. Var DateTime:TDateTime;
  2318. Begin
  2319.      If FValue<>Nil Then
  2320.      Begin
  2321.           DateTime:=GetAsDateTime;
  2322.           DateTimeToString(result,DisplayFormat,DateTime);
  2323.      End
  2324.      Else Result:='';
  2325. End;
  2326.  
  2327. Procedure TDateTimeField.SetAsString(Const NewValue:String);
  2328. Var dt:TDateTime;
  2329.     Valid:Boolean;
  2330. Begin
  2331.      If NewValue <> '' Then
  2332.      Begin
  2333.           Try
  2334.              dt:=StrToDateTime(NewValue);
  2335.              Valid:=True;
  2336.           Except
  2337.              Valid:=False;
  2338.           End;
  2339.           If Valid Then SetAsDateTime(dt);
  2340.      End
  2341.      Else Clear;
  2342. End;
  2343.  
  2344. Function TDateTimeField.GetAsAnsiString:AnsiString;
  2345. Begin
  2346.     Result:=GetAsString;
  2347. End;
  2348.  
  2349. Procedure TDateTimeField.SetAsAnsiString(NewValue:AnsiString);
  2350. Begin
  2351.     SetAsString(NewValue);
  2352. End;
  2353.  
  2354. Function TDateTimeField.GetAsFloat:Extended;
  2355. Begin
  2356.      If FValue<>Nil Then Result:=GetAsDateTime
  2357.      Else AccessError('Float');
  2358. End;
  2359.  
  2360. Function TDateTimeField.GetAsDateTime:TDateTime;
  2361. Var  dt:TODBCDateTime;
  2362. Begin
  2363.      If FValue<>Nil Then
  2364.      Begin
  2365.           dt:=TODBCDateTime(FValue^);
  2366.           Result:=EncodeDate(dt.Date.Year,dt.Date.Month,dt.Date.Day) +
  2367.                   EncodeTime(dt.Time.Hour,dt.Time.Minute,dt.Time.Second,0);
  2368.      End
  2369.      Else AccessError('DateTime');
  2370. End;
  2371.  
  2372. Procedure TDateTimeField.SetAsDateTime(NewValue:TDateTime);
  2373. Var  R:TODBCDateTime;
  2374. Begin
  2375.      DecodeDate(NewValue,R.Date.Year,R.Date.Month,R.Date.Day);
  2376.      RoundDecodeTime(NewValue,R.Time.Hour,R.Time.Minute,R.Time.Second);
  2377.      SetNewValue(R,SizeOf(R));
  2378. End;
  2379.  
  2380. {
  2381. ╔═══════════════════════════════════════════════════════════════════════════╗
  2382. ║                                                                           ║
  2383. ║ Speed-Pascal/2 Version 2.0                                                ║
  2384. ║                                                                           ║
  2385. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2386. ║                                                                           ║
  2387. ║ This section: TBlobField Class Implementation                             ║
  2388. ║                                                                           ║
  2389. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2390. ║                                                                           ║
  2391. ╚═══════════════════════════════════════════════════════════════════════════╝
  2392. }
  2393.  
  2394. Function TBlobField.GetAsString:String;
  2395. Begin
  2396.      If FValue <> Nil Then Result := '[Blob]'
  2397.      Else Result := '[BLOB]';
  2398. End;
  2399.  
  2400. Function TBlobField.GetAsAnsiString:AnsiString;
  2401. Begin
  2402.      Result := GetAsString;
  2403. End;
  2404.  
  2405. Procedure TBlobField.LoadFromStream(Stream:TStream);
  2406. Var  prec:^Byte;
  2407. Begin
  2408.      If Stream Is TStream Then
  2409.      Begin
  2410.           GetMem(prec, Stream.Size);
  2411.           Stream.Position := 0;
  2412.           Stream.Read(prec^,Stream.Size);
  2413.           SetAsValue(prec^, Stream.Size);
  2414.           FreeMem(prec, Stream.Size);
  2415.      End;
  2416. End;
  2417.  
  2418. {
  2419. ╔═══════════════════════════════════════════════════════════════════════════╗
  2420. ║                                                                           ║
  2421. ║ Speed-Pascal/2 Version 2.0                                                ║
  2422. ║                                                                           ║
  2423. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2424. ║                                                                           ║
  2425. ║ This section: TMemoField Class Implementation                             ║
  2426. ║                                                                           ║
  2427. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2428. ║                                                                           ║
  2429. ╚═══════════════════════════════════════════════════════════════════════════╝
  2430. }
  2431.  
  2432. Function TMemoField.GetAsString:String;
  2433. Begin
  2434.      If FValue <> Nil Then Result := '[Memo]'
  2435.      Else Result := '[MEMO]';
  2436. End;
  2437.  
  2438. Function TMemoField.GetAsAnsiString:AnsiString;
  2439. Begin
  2440.      If FValue = Nil Then Result := ''
  2441.      Else Result := PChar(FValue)^;
  2442. End;
  2443.  
  2444. Procedure TMemoField.SetAsAnsiString(NewValue:AnsiString);
  2445. Begin
  2446.      If NewValue <> '' Then
  2447.      Begin
  2448.           SetNewValue(PChar(NewValue)^,length(PChar(NewValue)^)+1);
  2449.      End
  2450.      Else Clear;
  2451. End;
  2452.  
  2453. {
  2454. ╔═══════════════════════════════════════════════════════════════════════════╗
  2455. ║                                                                           ║
  2456. ║ Speed-Pascal/2 Version 2.0                                                ║
  2457. ║                                                                           ║
  2458. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2459. ║                                                                           ║
  2460. ║ This section: TGraphicField Class Implementation                          ║
  2461. ║                                                                           ║
  2462. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2463. ║                                                                           ║
  2464. ╚═══════════════════════════════════════════════════════════════════════════╝
  2465. }
  2466.  
  2467. Function TGraphicField.GetAsString:String;
  2468. Begin
  2469.      If FValue<>Nil Then Result:='[Graphic]'
  2470.      Else Result:='[GRAPHIC]';
  2471. End;
  2472.  
  2473. {
  2474. ╔═══════════════════════════════════════════════════════════════════════════╗
  2475. ║                                                                           ║
  2476. ║ Speed-Pascal/2 Version 2.0                                                ║
  2477. ║                                                                           ║
  2478. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2479. ║                                                                           ║
  2480. ║ This section: TFieldList Class Implementation                             ║
  2481. ║                                                                           ║
  2482. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2483. ║                                                                           ║
  2484. ╚═══════════════════════════════════════════════════════════════════════════╝
  2485. }
  2486.  
  2487. Procedure TFieldList.Clear;
  2488. Var T:LongInt;
  2489.     field:TField;
  2490. Begin
  2491.      For T:=0 To Count-1 Do
  2492.      Begin
  2493.           field:=Items[T];
  2494.           field.Destroy;
  2495.      End;
  2496.      Inherited Clear;
  2497. End;
  2498.  
  2499.  
  2500.  
  2501. {
  2502. ╔═══════════════════════════════════════════════════════════════════════════╗
  2503. ║                                                                           ║
  2504. ║ Speed-Pascal/2 Version 2.0                                                ║
  2505. ║                                                                           ║
  2506. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2507. ║                                                                           ║
  2508. ║ This section: TIndexDef Class Implementation                              ║
  2509. ║                                                                           ║
  2510. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2511. ║                                                                           ║
  2512. ╚═══════════════════════════════════════════════════════════════════════════╝
  2513. }
  2514.  
  2515. Function TIndexDef.GetName:String;
  2516. Begin
  2517.     If FName<>Nil Then Result:=FName^
  2518.     Else Result:='';
  2519. End;
  2520.  
  2521. Function TIndexDef.GetFields:String;
  2522. Begin
  2523.      If FFields<>Nil Then Result:=FFields^
  2524.      Else Result:='';
  2525. End;
  2526.  
  2527. Constructor TIndexDef.Create(Owner:TIndexDefs;Const Name, Fields:String;Options:TIndexOptions);
  2528. Begin
  2529.      Inherited Create;
  2530.  
  2531.      If Owner <> Nil Then
  2532.      Begin
  2533.          Owner.FItems.Add(Self);
  2534.          FOwner:=Owner;
  2535.      End;
  2536.  
  2537.      AssignStr(FName,Name);
  2538.      AssignStr(FFields,Fields);
  2539.      FOptions:=Options;
  2540. End;
  2541.  
  2542. Destructor TIndexDef.Destroy;
  2543. Begin
  2544.      If FOwner <> Nil Then FOwner.FItems.Remove(Self);
  2545.  
  2546.      AssignStr(FName,'');
  2547.      AssignStr(FFields,'');
  2548.  
  2549.      Inherited Destroy;
  2550. End;
  2551.  
  2552. {
  2553. ╔═══════════════════════════════════════════════════════════════════════════╗
  2554. ║                                                                           ║
  2555. ║ Speed-Pascal/2 Version 2.0                                                ║
  2556. ║                                                                           ║
  2557. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2558. ║                                                                           ║
  2559. ║ This section: TIndexDefs Class Implementation                             ║
  2560. ║                                                                           ║
  2561. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2562. ║                                                                           ║
  2563. ╚═══════════════════════════════════════════════════════════════════════════╝
  2564. }
  2565.  
  2566. Function TIndexDefs.GetCount:LongInt;
  2567. Begin
  2568.      Result:=FItems.Count;
  2569. End;
  2570.  
  2571. Function TIndexDefs.GetItem(Index:LongInt):TIndexDef;
  2572. Begin
  2573.      Result:=TIndexDef(FItems[Index]);
  2574. End;
  2575.  
  2576. Constructor TIndexDefs.Create(DataSet:TDataSet);
  2577. Begin
  2578.      Inherited Create;
  2579.      FDataSet:=DataSet;
  2580.      FItems.Create;
  2581. End;
  2582.  
  2583. Destructor TIndexDefs.Destroy;
  2584. Begin
  2585.      Clear;
  2586.      FItems.Destroy;
  2587.      Inherited Destroy;
  2588. End;
  2589.  
  2590. Procedure TIndexDefs.Clear;
  2591. Var IndexDef:TIndexDef;
  2592. Begin
  2593.      While FItems.Count > 0 Do
  2594.      Begin
  2595.           IndexDef := TIndexDef(FItems[0]);
  2596.           IndexDef.Destroy; // auto removing from FItems
  2597.      End;
  2598. End;
  2599.  
  2600. Function TIndexDefs.Add(Const Name,Fields:String;Options:TIndexOptions):TIndexDef;
  2601. Begin
  2602.      //...check valid
  2603.      Result.Create(Self, Name, Fields,Options);
  2604. End;
  2605.  
  2606. Procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
  2607. Var IndexDef:TIndexDef;
  2608.     t:LongInt;
  2609. Begin
  2610.      Clear;
  2611.      For t:=0 To IndexDefs.Count-1 Do
  2612.      Begin
  2613.           IndexDef:=IndexDefs.Items[t];
  2614.           Add(IndexDef.Name,IndexDef.Fields,IndexDef.Options);
  2615.      End;
  2616. End;
  2617.  
  2618. Function TIndexDefs.FindIndexForFields(Const Fields:String):TIndexDef;
  2619. Begin
  2620.      Result:=GetIndexForFields(Fields,False);
  2621.      If Result=Nil Then DataBaseError('No index for fields: '+Fields);
  2622. End;
  2623.  
  2624. Function TIndexDefs.GetIndexForFields(Const Fields:String;CaseInsensitive:Boolean):TIndexDef;
  2625. Var t:LongInt;
  2626.     s,s1:String;
  2627. Begin
  2628.      s:=Fields;
  2629.      If CaseInsensitive Then UpcaseStr(s);
  2630.      Result:=Nil;
  2631.      For t:=0 To Count-1 Do
  2632.      Begin
  2633.           s1:=Items[t].Fields;
  2634.           If CaseInsensitive Then UpcaseStr(s1);
  2635.           If s=s1 Then
  2636.           Begin
  2637.                Result:=Items[t];
  2638.                exit;
  2639.           End;
  2640.      End;
  2641. End;
  2642.  
  2643. Function TIndexDefs.IndexOf(Const Name:String):LongInt;
  2644. Var t:LongInt;
  2645. Begin
  2646.      Result:=-1;
  2647.      For t:=0 To Count-1 Do If Items[t].Name=Name Then
  2648.      Begin
  2649.           Result:=t;
  2650.           exit;
  2651.      End;
  2652. End;
  2653.  
  2654. Procedure TIndexDefs.Update;
  2655. Begin
  2656.      TTable(FDataSet).UpdateIndexDefs;
  2657. End;
  2658.  
  2659. {
  2660. ╔═══════════════════════════════════════════════════════════════════════════╗
  2661. ║                                                                           ║
  2662. ║ Speed-Pascal/2 Version 2.0                                                ║
  2663. ║                                                                           ║
  2664. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2665. ║                                                                           ║
  2666. ║ This section: TFieldDef Class Implementation                              ║
  2667. ║                                                                           ║
  2668. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2669. ║                                                                           ║
  2670. ╚═══════════════════════════════════════════════════════════════════════════╝
  2671. }
  2672.  
  2673. Constructor TFieldDef.Create(aOwner:TFieldDefs; Const aName:String;
  2674.   aDataType:TFieldType; aSize:Longword; aRequired:Boolean; aFieldNo:Longint);
  2675. Begin
  2676.      Inherited Create;
  2677.  
  2678.      If aOwner <> Nil Then
  2679.      Begin
  2680.           aFieldNo := aOwner.FItems.Add(Self);
  2681.           FOwner := aOwner;
  2682.      End;
  2683.  
  2684.      FName := aName;
  2685.      FDataType := aDataType;
  2686.      FSize := aSize;
  2687.        If aDataType = ftString Then Inc(FSize);
  2688.      FRequired := aRequired;
  2689.      FFieldNo := aFieldNo;
  2690.      FPrecision := -1;
  2691.      If FDataType In [ftWord,ftInteger,ftSmallInt] Then
  2692.        If not (FSize In [1,2,4]) Then FSize:=4; //LongInt
  2693.      If FDataType=ftFloat Then
  2694.        If not (FSize In [4,8,10]) Then FSize:=10; //Extended
  2695.      FFields.Create;
  2696. End;
  2697.  
  2698. Function TFieldDef.GetTypeName:String;
  2699. Begin
  2700.      If FTypeName=Nil Then
  2701.      Begin
  2702.           Result:='';
  2703.           If FOwner.FDataSet Is TTable Then
  2704.             Result:=TTable(FOwner.FDataSet).DataType2Name(FDataType);
  2705.      End
  2706.      Else Result:=FTypeName^;
  2707. End;
  2708.  
  2709. Procedure TFieldDef.SetTypeName(Const NewValue:String);
  2710. Begin
  2711.      AssignStr(FTypeName,NewValue);
  2712. End;
  2713.  
  2714. Destructor TFieldDef.Destroy;
  2715. Var  i:Longint;
  2716.      Field:TField;
  2717. Begin
  2718.      If FOwner <> Nil Then FOwner.FItems.Remove(Self);
  2719.  
  2720.      If FFields <> Nil Then
  2721.      Begin
  2722.           For i := 0 To FFields.Count-1 Do
  2723.           Begin
  2724.                Field := TField(FFields[i]);
  2725.                If Field <> Nil Then Field.Destroy;
  2726.           End;
  2727.      End;
  2728.  
  2729.      AssignStr(FForeignKey,'');
  2730.      AssignStr(FTypeName,'');
  2731.  
  2732.      FFields.Destroy;
  2733.      FFields := Nil;
  2734.  
  2735.      Inherited Destroy;
  2736. End;
  2737.  
  2738.  
  2739. Function TFieldDef.CreateField(Owner:TComponent):TField;
  2740. Var  FieldClass:TFieldClass;
  2741. Begin
  2742.      FieldClass := GetFieldClass;
  2743.      If FieldClass = Nil Then DatabaseError('Unknown field type "'+Name+'"');
  2744.  
  2745.      Result := FieldClass.Create;
  2746.      Try
  2747.         Result.FFieldDef := Self;
  2748.         Result.FRequired := Required;
  2749.         Result.FSize := Size;
  2750.         Result.FDataType := FDataType;
  2751.         If Result Is TFloatField Then
  2752.         Begin
  2753.              TFloatField(Result).FPrecision := Precision;
  2754.              If not (Size In [4,8]) Then
  2755.              Begin
  2756.                   Size:=8;
  2757.                   Result.FSize:=8;
  2758.              End;
  2759.         End;
  2760.         If FOwner <> Nil Then Result.FDataSet := FOwner.FDataSet;
  2761.         GetMem(Result.FValue,Size);
  2762.         Result.FValueLen := Size;
  2763.      Except;
  2764.         Result.Free;
  2765.         Raise;
  2766.      End;
  2767. End;
  2768.  
  2769.  
  2770. Function TFieldDef.GetFieldClass:TFieldClass;
  2771. Begin
  2772.      Result := FOwner.FDataSet.GetFieldClass(FDataType);
  2773. End;
  2774.  
  2775.  
  2776. Function TFieldDef.GetPrimaryKey:Boolean;
  2777. Var Keys:TStrings;
  2778.     t:LongInt;
  2779. Begin
  2780.      If (Not (FOwner.FDataSet.IsTable)) Then
  2781.         DataBaseError('Cannot perform this action on a query or stored procedure');
  2782.  
  2783.      Result:=False;
  2784.      If FOwner.FDataSet.Active Then
  2785.      Begin
  2786.           Keys.Create;
  2787.           TTable(FOwner.FDataSet).GetPrimaryKeys(Keys);
  2788.           For t:=0 To Keys.Count-1 Do
  2789.             If Keys[t]=Name Then
  2790.             Begin
  2791.                  Keys.Destroy;
  2792.                  Result:=True;
  2793.                  exit;
  2794.             End;
  2795.           Keys.Destroy;
  2796.      End
  2797.      Else Result:=FPrimaryKey;
  2798. End;
  2799.  
  2800. Procedure TFieldDef.SetPrimaryKey(NewValue:Boolean);
  2801. Begin
  2802.      If (Not (FOwner.FDataSet.IsTable)) Then
  2803.         DataBaseError('Cannot perform this action on a query or stored procedure');
  2804.  
  2805.      FPrimaryKey:=NewValue;
  2806.      If FOwner.FDataSet.Active Then //Modify table definition
  2807.      Begin
  2808.      End;
  2809. End;
  2810.  
  2811. Function TFieldDef.GetForeignKey:String;
  2812. Var Keys:TStrings;
  2813.     t:LongInt;
  2814.     s:String;
  2815. Begin
  2816.      If (Not (FOwner.FDataSet.IsTable)) Then
  2817.         DataBaseError('Cannot perform this action on a query or stored procedure');
  2818.  
  2819.      If FOwner.FDataSet.Active Then
  2820.      Begin
  2821.           Keys.Create;
  2822.           TTable(FOwner.FDataSet).GetForeignKeys(Keys);
  2823.           For t:=0 To Keys.Count-1 Do
  2824.           Begin
  2825.             s:=Keys[t];
  2826.             If Pos('>',s)<>0 Then s[0]:=chr(pos('>',s)-1);
  2827.             If s=Name Then
  2828.             Begin
  2829.                  Keys.Destroy;
  2830.                  s:=Keys[t];
  2831.                  Delete(s,1,pos('>',s));
  2832.                  Result:=s;
  2833.                  exit;
  2834.             End;
  2835.           End;
  2836.           Keys.Destroy;
  2837.      End
  2838.      Else
  2839.      Begin
  2840.          If FForeignKey<>Nil Then Result:=FForeignKey^
  2841.          Else Result:='';
  2842.      End;
  2843. End;
  2844.  
  2845. Procedure TFieldDef.SetForeignKey(Const NewValue:String);
  2846. Begin
  2847.      If (Not (FOwner.FDataSet.IsTable)) Then
  2848.         DataBaseError('Cannot perform this action on a query or stored procedure');
  2849.  
  2850.      AssignStr(FForeignKey,NewValue);
  2851.      If FOwner.FDataSet.Active Then //modify table definition
  2852.      Begin
  2853.      End;
  2854. End;
  2855.  
  2856. {
  2857. ╔═══════════════════════════════════════════════════════════════════════════╗
  2858. ║                                                                           ║
  2859. ║ Speed-Pascal/2 Version 2.0                                                ║
  2860. ║                                                                           ║
  2861. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2862. ║                                                                           ║
  2863. ║ This section: TFieldDefs Class Implementation                             ║
  2864. ║                                                                           ║
  2865. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2866. ║                                                                           ║
  2867. ╚═══════════════════════════════════════════════════════════════════════════╝
  2868. }
  2869.  
  2870. Constructor TFieldDefs.Create(DataSet:TDataSet);
  2871. Begin
  2872.      Inherited Create;
  2873.  
  2874.      FDataSet := DataSet;
  2875.      FItems.Create;
  2876. End;
  2877.  
  2878.  
  2879. Destructor TFieldDefs.Destroy;
  2880. Begin
  2881.      Clear;
  2882.      FItems.Destroy;
  2883.  
  2884.      Inherited Destroy;
  2885. End;
  2886.  
  2887.  
  2888. Function TFieldDefs.Rows:LongInt;
  2889. Var  FieldDef:TFieldDef;
  2890. Begin
  2891.      Result := 0;
  2892.      If Count = 0 Then Exit;
  2893.      FieldDef := Items[0];
  2894.      Result := FieldDef.Fields.Count;
  2895. End;
  2896.  
  2897.  
  2898. Procedure TFieldDefs.Clear;
  2899. Var  FieldDef:TFieldDef;
  2900. Begin
  2901.      While FItems.Count > 0 Do
  2902.      Begin
  2903.           FieldDef := TFieldDef(FItems[0]);
  2904.           FieldDef.Destroy; // auto removing from FItems
  2905.      End;
  2906. End;
  2907.  
  2908.  
  2909. Function TFieldDefs.GetCount:Longint;
  2910. Begin
  2911.      Result := FItems.Count;
  2912. End;
  2913.  
  2914.  
  2915. Function TFieldDefs.GetItem(Index:Longint):TFieldDef;
  2916. Begin
  2917.      Result := FItems[Index];
  2918. End;
  2919.  
  2920.  
  2921. Function TFieldDefs.Add(Const Name:String; DataType:TFieldType; Size:Longint; Required:Boolean):TFieldDef;
  2922. Begin
  2923.      //...check valid
  2924.      Result.Create(Self, Name, DataType, Size, Required, FItems.Count);
  2925. End;
  2926.  
  2927. Procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
  2928. Var FieldDef:TFieldDef;
  2929.     t:LongInt;
  2930. Begin
  2931.      Clear;
  2932.      For t:=0 To FieldDefs.Count-1 Do
  2933.      Begin
  2934.           FieldDef:=Items[t];
  2935.           Add(FieldDef.Name,FieldDef.DataType,FieldDef.Size,FieldDef.Required);
  2936.      End;
  2937. End;
  2938.  
  2939. Function TFieldDefs.Find(const Name: string): TFieldDef;
  2940. Var Index:LongInt;
  2941. Begin
  2942.      Index:=IndexOf(Name);
  2943.      If Index=-1 Then SQLError('Field not found: '+Name)
  2944.      Else Result:=Items[Index];
  2945. End;
  2946.  
  2947. Function TFieldDefs.IndexOf(const Name: string): LongInt;
  2948. Var t:LongInt;
  2949. Begin
  2950.      Result:=-1;
  2951.      For t:=0 To Count-1 Do If Items[t].Name=Name Then
  2952.      Begin
  2953.           Result:=t;
  2954.           exit;
  2955.      End;
  2956. End;
  2957.  
  2958. Procedure TFieldDefs.Update;
  2959. Begin
  2960.      FDataSet.QueryTable;
  2961. End;
  2962.  
  2963. {
  2964. ╔═══════════════════════════════════════════════════════════════════════════╗
  2965. ║                                                                           ║
  2966. ║ Speed-Pascal/2 Version 2.0                                                ║
  2967. ║                                                                           ║
  2968. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2969. ║                                                                           ║
  2970. ║ This section: TDataSet Class Implementation                               ║
  2971. ║                                                                           ║
  2972. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2973. ║                                                                           ║
  2974. ╚═══════════════════════════════════════════════════════════════════════════╝
  2975. }
  2976.  
  2977. Const
  2978.    DefaultFieldClasses:Array[TFieldType] Of TFieldClass=
  2979.                     (TBlobField,       {ftUnknown}
  2980.                      TStringField,     {ftString}
  2981.                      TSmallintField,   {ftSmallInt}
  2982.                      TIntegerField,    {ftInteger}
  2983.                      TBlobField,       {ftWord}
  2984.                      TBlobField,       {ftBoolean}
  2985.                      TFloatField,      {ftFloat}
  2986.                      TCurrencyField,   {ftCurrency}
  2987.                      TBlobField,       {ftBCD}
  2988.                      TDateField,       {ftDate}
  2989.                      TTimeField,       {ftTime}
  2990.                      TDateTimeField,   {ftDateTime}
  2991.                      TBlobField,       {ftBytes}
  2992.                      TBlobField,       {ftVarBytes}
  2993.                      TAutoIncField,    {ftAutoInc}
  2994.                      TBlobField,       {ftBlob}
  2995.                      TMemoField,       {ftMemo}
  2996.                      TGraphicField,    {ftGraphic}
  2997.                      TMemoField,       {ftFmtMemo}
  2998.                      TBlobField,       {ftTypedBinary}
  2999.                      TBlobField        {ftOLE}
  3000.                     );
  3001.  
  3002.  
  3003. Procedure TDataSet.SetupComponent;
  3004. Begin
  3005.      Include(ComponentState, csHandleLinks);
  3006.  
  3007.      AssignStr(FDataBase,'');
  3008.      AssignStr(FServer,'');
  3009.  
  3010.      Inherited SetupComponent;
  3011.  
  3012.      Name:='DataSet';
  3013.      FFieldDefs.Create(Self);
  3014.      FSelect:=TStringList.Create;
  3015.      FCurrentRow:=-1;
  3016.      FCurrentField:=0;
  3017. End;
  3018.  
  3019. Destructor TDataSet.Destroy;
  3020. Begin
  3021.      FFieldDefs.Destroy;
  3022.      FFieldDefs:=Nil;
  3023.      AssignStr(FServer,'');
  3024.      AssignStr(FDataBase,'');
  3025.      FSelect.Destroy;
  3026.      FSelect:=Nil;
  3027.  
  3028.      Inherited Destroy;
  3029. End;
  3030.  
  3031.  
  3032. Function TDataSet.GetFieldClass(FieldType:TFieldType):TFieldClass;
  3033. Begin
  3034.      Result := DefaultFieldClasses[FieldType];
  3035. End;
  3036.  
  3037.  
  3038. Procedure TDataSet.DesignerNotification(Var DNS:TDesignerNotifyStruct);
  3039. Var  AForm:TForm;
  3040. Begin
  3041.      AForm := TForm(Owner);
  3042.      If AForm <> Nil Then
  3043.      Begin
  3044.           While (AForm.Designed) And (AForm.Owner <> Nil) Do
  3045.           Begin
  3046.                AForm := TForm(AForm.Owner);
  3047.           End;
  3048.      End;
  3049.      If AForm <> Nil Then
  3050.       If AForm Is TForm Then AForm.DesignerNotification(DNS);
  3051. End;
  3052.  
  3053.  
  3054. Function TDataSet.Locate(Const KeyFields:String;Const KeyValues:Array Of Const;
  3055.                          Options:TLocateOptions):Boolean;
  3056. Begin
  3057.      Result := False;
  3058.      //???
  3059. End;
  3060.  
  3061.  
  3062. Procedure TDataSet.SetFieldDefs(NewValue:TFieldDefs);
  3063. Begin
  3064.      FFieldDefs.Assign(NewValue);
  3065. End;
  3066.  
  3067.  
  3068. Procedure TDataSet.GetStoredProcNames(List:TStrings);
  3069. Begin
  3070.      List.Clear;
  3071. End;
  3072.  
  3073.  
  3074. Procedure TDataSet.Open;
  3075. Begin
  3076.      Active := True;
  3077. End;
  3078.  
  3079.  
  3080. Procedure TDataSet.Close;
  3081. Begin
  3082.      Active := False;
  3083. End;
  3084.  
  3085.  
  3086. Procedure TDataSet.SetActive(NewValue:Boolean);
  3087. Begin
  3088.      If FActive <> NewValue Then
  3089.      Begin
  3090.           FActive := NewValue;
  3091.           DataChange(deDataBaseChanged);
  3092.      End;
  3093. End;
  3094.  
  3095.  
  3096. Procedure TDataSet.SetCurrentRow(NewValue:LongInt);
  3097. Begin
  3098.      MoveBy(NewValue-FCurrentRow);
  3099. End;
  3100.  
  3101.  
  3102. Procedure TDataSet.SetCurrentField(NewValue:LongInt);
  3103. Begin
  3104.      If NewValue<0 Then NewValue:=0;
  3105.      If NewValue>FieldCount-1 Then NewValue:=FieldCount-1;
  3106.      FCurrentField:=NewValue;
  3107. End;
  3108.  
  3109.  
  3110. Function TDataSet.GetEOF:Boolean;
  3111. Begin
  3112.      Result := GetResultColRow(0,FCurrentRow+1) = Nil;
  3113. End;
  3114.  
  3115.  
  3116. Function TDataSet.GetBOF:Boolean;
  3117. Begin
  3118.      Result := FCurrentRow <= 0;
  3119. End;
  3120.  
  3121.  
  3122. Function TDataSet.GetMaxRows:LongInt;
  3123. Begin
  3124.      Result := FMaxRows;
  3125.      If RowInserted Then inc(Result);
  3126. End;
  3127.  
  3128.  
  3129. Procedure TDataSet.Refresh;
  3130. Begin
  3131.      DataChange(deDataBaseChanged);
  3132. End;
  3133.  
  3134.  
  3135. Procedure TDataSet.DataChange(event:TDataChange);
  3136. Var I:LongInt;
  3137.     Source:TDataSource;
  3138.     FLinkList:TList;
  3139. Begin
  3140.      If FDataChangeLock Then Exit;
  3141.  
  3142.      FLinkList:=FreeNotifyList;
  3143.      If FLinkList<>Nil Then For I:=0 To FLinkList.Count-1 Do
  3144.      Begin
  3145.           Source:=FLinkList.Items[I];
  3146.           If Source Is TDataSource Then
  3147.           Begin
  3148.                Source.DataChange(event);
  3149.                If Source.OnDataChange<>Nil Then Source.OnDataChange(Source,event);
  3150.           End;
  3151.      End;
  3152. End;
  3153.  
  3154.  
  3155. Procedure TDataSet.First;
  3156. Begin
  3157.      SetCurrentRow(0);
  3158. End;
  3159.  
  3160.  
  3161. Procedure TDataSet.Last;
  3162. Begin
  3163.      SetCurrentRow(MaxRows-1);
  3164. End;
  3165.  
  3166.  
  3167. Procedure TDataSet.Next;
  3168. Begin
  3169.      SetCurrentRow(FCurrentRow+1);
  3170. End;
  3171.  
  3172.  
  3173. Procedure TDataSet.Prior;
  3174. Begin
  3175.      SetCurrentRow(FCurrentRow-1);
  3176. End;
  3177.  
  3178.  
  3179. Procedure TDataSet.MoveBy(Distance:LongInt);
  3180. Var  Field:TField;
  3181.      FieldDef:TFieldDef;
  3182. Begin
  3183.      If Distance = 0 Then Exit;
  3184.      If FFieldDefs.Count = 0 Then exit;
  3185.  
  3186.      If FRowIsInserted Then CommitInsert(True);
  3187.  
  3188.      FCurrentRow := FCurrentRow + Distance;
  3189.      If FCurrentRow < 0 Then FCurrentRow := 0;
  3190.      If FCurrentRow >= MaxRows Then FCurrentRow := MaxRows-1;
  3191.  
  3192.      Field := GetResultColRow(0,FCurrentRow);
  3193.  
  3194.      FieldDef := FFieldDefs[0];
  3195.  
  3196.      If FieldDef <> Nil Then
  3197.      Begin
  3198.           If FCurrentRow > FieldDef.Fields.Count-1
  3199.           Then FCurrentRow := FieldDef.Fields.Count-1;
  3200.           If FCurrentRow < 0 Then FCurrentRow := 0;
  3201.      End;
  3202.  
  3203.      DataChange(dePositionChanged);
  3204. End;
  3205.  
  3206.  
  3207. Function TDataSet.WriteSCUResource(Stream:TResourceStream):Boolean;
  3208. Var S:String;
  3209.     dll:String;
  3210.     P,p1:Pointer;
  3211.     len:LongInt;
  3212.     dbType:TDBTypes;
  3213.     dbOrd:LongInt;
  3214.     DriverName,Advanced,UID:String;
  3215. Begin
  3216.      S:=Server;
  3217.      GetDBServerFromAlias(S,dll,dbType);
  3218.      dbOrd:=ord(dbType);
  3219.  
  3220.      len:=Length(S)+1+Length(dll)+1+4;
  3221.      GetMem(P,len);
  3222.      p1:=P;
  3223.      Move(S,p1^,Length(S)+1);
  3224.      Inc(p1,Length(S)+1);
  3225.      Move(dll,p1^,Length(dll)+1);
  3226.      inc(p1,length(dll)+1);
  3227.      Move(dbOrd,p1^,4);
  3228.      Result:=Stream.NewResourceEntry(rnDBServer,P^,len);
  3229.      FreeMem(P,len);
  3230.      If Not Result Then Exit;
  3231.  
  3232.      S:=DataBase;
  3233.      GetDBServerFromDBAlias(S,DriverName,Advanced,UID);
  3234.      len:=Length(S)+1+Length(Advanced)+1+length(UID)+1;
  3235.      GetMem(P,len);
  3236.      p1:=P;
  3237.      Move(S,p1^,Length(S)+1);
  3238.      Inc(p1,Length(S)+1);
  3239.      Move(Advanced,p1^,Length(Advanced)+1);
  3240.      Inc(p1,Length(Advanced)+1);
  3241.      Move(UID,p1^,Length(UID)+1);
  3242.      Result:=Stream.NewResourceEntry(rnDBDataBase,S,Length(S)+1);
  3243.      FreeMem(P,len);
  3244. End;
  3245.  
  3246.  
  3247. Procedure TDataSet.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  3248. Var
  3249.    S,dll:String;
  3250.    B:^Byte;
  3251.    dbType:TDBTypes;
  3252.    Advanced,UID:String;
  3253. Begin
  3254.      If ResName = rnDBServer Then
  3255.      Begin
  3256.           dbType:=ODBC;
  3257.  
  3258.           B:=@Data;
  3259.           Move(B^,S,B^+1);
  3260.           Inc(B,B^+1);
  3261.           Move(B^,dll,B^+1);
  3262.  
  3263.           If DataLen>length(S)+1+length(dll)+1 Then //Sibyl FP3
  3264.           Begin
  3265.                inc(B,length(dll)+1);
  3266.                move(B^,dbType,sizeof(dbType));
  3267.           End;
  3268.  
  3269.           AddServerAlias(S,dll,dbType);
  3270.           Server:=S;
  3271.      End;
  3272.  
  3273.      If ResName = rnDBDataBase Then
  3274.      Begin
  3275.           Advanced:='';
  3276.           UID:='';
  3277.  
  3278.           B:=@Data;
  3279.           Move(B^,S,B^+1);
  3280.           Inc(B,B^+1);
  3281.           If DataLen>length(S)+1 Then //Sibyl FP3
  3282.           Begin
  3283.                Move(B^,Advanced,B^+1);
  3284.                Inc(B,B^+1);
  3285.                Move(B^,UID,B^+1);
  3286.           End;
  3287.  
  3288.           AddDataBaseAlias(S,Server,Advanced,UID);
  3289.           DataBase:=S;
  3290.      End;
  3291. End;
  3292.  
  3293.  
  3294. Function TDataSet.GetDataBaseName:String;
  3295. Begin
  3296.      Result:=FDataBase^;
  3297. End;
  3298.  
  3299.  
  3300. Procedure TDataSet.SetDataBaseName(Const NewValue:String);
  3301. Var  Alias,Advanced,UID,DllName:String;
  3302.      DNS:TDesignerNotifyStruct;
  3303. Begin
  3304.      If GetDataBaseName=NewValue Then Exit;
  3305.  
  3306.      If FOpened Then
  3307.        If GetDataBaseName<>'' Then
  3308.        Begin
  3309.             ErrorBox(LoadNLSStr(SCannotPerformDBAction));
  3310.             Exit;
  3311.        End;
  3312.  
  3313.      AssignStr(FDataBase,NewValue);
  3314.  
  3315.      FreeDBProcs(FDBProcs);
  3316.      FDBProcs.DataBase:=NewValue;
  3317.  
  3318.      GetDBServerFromDBAlias(NewValue,Alias,Advanced,UID);
  3319.      If Alias<>'' Then If Alias<>Server Then
  3320.      Begin
  3321.           AssignStr(FServer, Alias);
  3322.           FDBProcs.AliasName:=Alias;
  3323.      End;
  3324.      If ComponentState*[csReading]=[] Then FDBProcs.UID:=UID
  3325.      Else If FDBProcs.UID='' Then FDBProcs.UID:=UID;
  3326.      GetDBServerFromAlias(FDBProcs.AliasName,DllName,FDBProcs.DBType);
  3327.  
  3328.      Case FDBProcs.DBType Of
  3329.        Native_mSQL:
  3330.        Begin
  3331.             If ComponentState*[csReading]=[] Then FDBProcs.Host:=Advanced
  3332.             Else If FDBProcs.Host='' Then FDBProcs.Host:=Advanced;
  3333.        End;
  3334.      End;
  3335.  
  3336.      If Self Is TTable Then If ComponentState*[csReading]=[] Then
  3337.      Begin
  3338.          TTable(Self).TableName:='';
  3339.          TTable(Self).UserId:='';
  3340.          TTable(Self).Password:='';
  3341.      End;
  3342.  
  3343.      DNS.Sender := Self;
  3344.      DNS.Code := dncPropertyUpdate;
  3345.      DNS.return := 0;
  3346.      DesignerNotification(DNS);
  3347. End;
  3348.  
  3349.  
  3350. Function TDataSet.GetServer:String;
  3351. Begin
  3352.      Result:=FServer^;
  3353. End;
  3354.  
  3355.  
  3356. Procedure TDataSet.SetServer(Const NewValue:String);
  3357. Var WasLocked:Boolean;
  3358.     DllName:String;
  3359.     DNS:TDesignerNotifyStruct;
  3360. Begin
  3361.      If GetServer=NewValue Then Exit;
  3362.  
  3363.      If FOpened Then
  3364.      Begin
  3365.           ErrorBox(LoadNLSStr(SCannotPerformDBAction));
  3366.           Exit;
  3367.      End;
  3368.  
  3369.      FreeDBProcs(FDBProcs);
  3370.  
  3371.      AssignStr(FServer,NewValue);
  3372.  
  3373.      FDBProcs.AliasName:=NewValue;
  3374.      GetDBServerFromAlias(FDBProcs.AliasName,DllName,FDBProcs.DBType);
  3375.  
  3376.      WasLocked:=FDataSetLocked;
  3377.      FDataSetLocked:=True;
  3378.  
  3379.      AssignStr(FDataBase,'');
  3380.  
  3381.      If Self Is TTable Then AssignStr(TTable(Self).FTableName,'');
  3382.  
  3383.      FDataSetLocked:=WasLocked;
  3384.  
  3385.      If ComponentState*[csReading]=[] Then
  3386.      Begin
  3387.          FDBProcs.UID:='';
  3388.          FDBProcs.Host:='';
  3389.      End;
  3390.      DNS.Sender := Self;
  3391.      DNS.Code := dncPropertyUpdate;
  3392.      DNS.return := 0;
  3393.      DesignerNotification(DNS);
  3394. End;
  3395.  
  3396.  
  3397. Function TDataSet.GetFieldCount:LongInt;
  3398. Begin
  3399.      Result:=FFieldDefs.Count;
  3400. End;
  3401.  
  3402.  
  3403. Function TDataSet.GetFieldName(Index:LongInt):String;
  3404. Var  FieldDef:TFieldDef;
  3405. Begin
  3406.      Result:='';
  3407.      If ((Index<0)Or(Index>FieldCount-1)) Then Exit;
  3408.      FieldDef:=FFieldDefs[Index];
  3409.      Result:=FieldDef.Name;
  3410. End;
  3411.  
  3412.  
  3413. Function TDataSet.GetFieldType(Index:LongInt):TFieldType;
  3414. Var  FieldDef:TFieldDef;
  3415. Begin
  3416.      Result:=ftUnknown;
  3417.      If ((Index<0)Or(Index>FieldCount-1)) Then Exit;
  3418.      FieldDef:=FFieldDefs[Index];
  3419.      Result:=FieldDef.DataType;
  3420. End;
  3421.  
  3422.  
  3423. Function TDataSet.GetFieldFromColumnName(ColumnName:String):TField;
  3424. Var Index:LongInt;
  3425.     T:LongInt;
  3426.     FieldDef:TFieldDef;
  3427.     S:String;
  3428. Begin
  3429.      Result:=Nil;
  3430.      Index:=-1;
  3431.      UpcaseStr(ColumnName);
  3432.      For T:=0 To FFieldDefs.Count-1 Do
  3433.      Begin
  3434.           FieldDef:=FFieldDefs[T];
  3435.           S:=FieldDef.Name;
  3436.           UpcaseStr(S);
  3437.           If S=ColumnName Then
  3438.           Begin
  3439.                Index:=T;
  3440.                break;
  3441.           End;
  3442.      End;
  3443.  
  3444.      If Index<>-1 Then Result:=Fields[Index];
  3445. End;
  3446.  
  3447.  
  3448. Procedure TDataSet.CheckRequiredFields;
  3449. Var  Field:TField;
  3450.      i:Longint;
  3451. Begin
  3452.      For i := 0 To FieldCount-1 Do
  3453.      Begin
  3454.           Field := GetResultColRow(i,FCurrentRow);
  3455.           If Field<>Nil Then
  3456.             If Field.Required And Field.IsNull Then
  3457.             Begin
  3458.                  //Field.FocusControl;
  3459.                  ErrorBox('Field '+ Field.FieldName +' is required');
  3460.                  DatabaseError('Field '+ Field.FieldName +' is required');
  3461.             End;
  3462.      End;
  3463. End;
  3464.  
  3465.  
  3466. Function TDataSet.GetField(Index:LongInt):TField;
  3467. Begin
  3468.      Result:=Nil;
  3469.      If ((Index<0)Or(Index>FieldCount-1)Or(FCurrentRow<0)) Then Exit;
  3470.      Result:=GetResultColRow(Index,FCurrentRow);
  3471. End;
  3472.  
  3473.  
  3474. Function TDataSet.GetResultColRow(Col,Row:LongInt):TField;
  3475. Var  FieldDef:TFieldDef;
  3476. Begin
  3477.      Result := Nil;
  3478.      If Not FOpened Then Exit;
  3479.  
  3480.      If Row < 0 Then Exit;  //Row does Not exist
  3481.      If Row >= GetMaxRows Then Exit;  //Row does Not exist
  3482.      If (Col < 0) Or (Col >= FieldDefs.Count) Then Exit;  {Column does Not exist}
  3483.  
  3484.      FieldDef := FieldDefs[Col];
  3485.      If Row <= FieldDef.Fields.Count-1
  3486.      Then Result := FieldDef.Fields.Items[Row];
  3487. End;
  3488.  
  3489.  
  3490. Procedure TDataSet.AppendRecord(Const values:Array Of Const);
  3491. Begin
  3492.      InsertRecord(values);
  3493. End;
  3494.  
  3495.  
  3496. Procedure TDataSet.SetFields(Const values:Array Of Const);
  3497. Var T:LongInt;
  3498.     rec:TVarRec;
  3499.     field:TField;
  3500. Begin
  3501.      Try
  3502.         FDataChangeLock:=True;
  3503.         For T:=0 To High(values) Do
  3504.         Begin
  3505.              If T>FieldCount-1 Then Exit;
  3506.              Field:=Fields[T];
  3507.              If Field=Nil Then continue;
  3508.  
  3509.              rec:=TVarRec(values[T]);
  3510.              Case rec.VType Of
  3511.                 vtInteger:field.AsInteger:=rec.VInteger;
  3512.                 vtBoolean:field.AsBoolean:=rec.VBoolean;
  3513.                 vtChar:field.AsString:=rec.VChar;
  3514.                 vtExtended:field.AsFloat:=rec.VExtended^;
  3515.                 vtString:field.AsString:=rec.VString^;
  3516.                 vtPointer:;
  3517.                 vtPChar:field.AsString:=rec.VPChar^;
  3518.                 vtAnsiString:field.AsString:=AnsiString(rec.VAnsiString);
  3519.              End; {Case}
  3520.         End;
  3521.      Finally
  3522.         FDataChangeLock:=False;
  3523.         Post;
  3524.      End;
  3525. End;
  3526.  
  3527.  
  3528. Procedure TDataSet.InsertRecord(Const values:Array Of Const);
  3529. Begin
  3530.      Try
  3531.         FDataChangeLock:=True;
  3532.         Insert;
  3533.      Finally
  3534.         FDataChangeLock:=False;
  3535.      End;
  3536.      SetFields(values);
  3537. End;
  3538.  
  3539.  
  3540. Function TDataSet.FieldByName(Const FieldName:String):TField;
  3541. Begin
  3542.      Result:=FindField(FieldName);
  3543.      If Result=Nil Then DatabaseError('Field '+FieldName+' not found');
  3544. End;
  3545.  
  3546.  
  3547. Function TDataSet.FindFirst:Boolean;
  3548. Begin
  3549.      Result:=BOF;
  3550. End;
  3551.  
  3552.  
  3553. Function TDataSet.FindLast:Boolean;
  3554. Begin
  3555.      Result:=EOF;
  3556. End;
  3557.  
  3558.  
  3559. Function TDataSet.FindNext:Boolean;
  3560. Begin
  3561.      Result:=not EOF;
  3562. End;
  3563.  
  3564.  
  3565. Function TDataSet.FindPrior:Boolean;
  3566. Begin
  3567.      Result:=not BOF;
  3568. End;
  3569.  
  3570.  
  3571. Function ExtractFieldName(Const Fields:String;Var Pos:LongInt):String;
  3572. Var  t:LongInt;
  3573. Begin
  3574.      t:=Pos;
  3575.      While (t<=Length(Fields))And(Fields[t]<>';') Do Inc(t);
  3576.      Result:=Copy(Fields,Pos,t-Pos);
  3577.      If (t<=Length(Fields))And(Fields[t]=';') Then Inc(t);
  3578.      Pos:=t;
  3579. End;
  3580.  
  3581.  
  3582. Procedure TDataSet.GetFieldList(List:TList; const FieldNames: string);
  3583. Var  t:LongInt;
  3584. Begin
  3585.      t:=1;
  3586.      While t<=Length(FieldNames) Do
  3587.        List.Add(FieldByName(ExtractFieldName(FieldNames,t)));
  3588. End;
  3589.  
  3590.  
  3591. Function TDataSet.FindField(Const FieldName:String):TField;
  3592. Var T:LongInt;
  3593.     S,s1:String;
  3594. Begin
  3595.      Result:=Nil;
  3596.      S:=FieldName;
  3597.      UpcaseStr(S);
  3598.      For T:=0 To FieldCount-1 Do
  3599.      Begin
  3600.           s1:=FieldNames[T];
  3601.           UpcaseStr(s1);
  3602.           If S=s1 Then
  3603.           Begin
  3604.                Result:=Fields[T];
  3605.                Exit;
  3606.           End;
  3607.      End;
  3608. End;
  3609.  
  3610.  
  3611. Procedure TDataSet.DoOpen;
  3612. Begin
  3613.      FOpened := True;
  3614. End;
  3615.  
  3616.  
  3617. Procedure TDataSet.DoClose;
  3618. Begin
  3619.      If FRowIsInserted Then CommitInsert(True);
  3620.      FMaxRows:=0;
  3621.      FCurrentRow := -1;
  3622.  
  3623.      FOpened := False;
  3624. End;
  3625.  
  3626.  
  3627. Procedure TDataSet.RefreshTable;
  3628. Begin
  3629. End;
  3630.  
  3631.  
  3632. Procedure TDataSet.GetDataSources(List:TStrings);
  3633. Begin
  3634.      List.Clear;
  3635. End;
  3636.  
  3637.  
  3638. Procedure TDataSet.GetFieldNames(List:TStrings);
  3639. Var T:LongInt;
  3640. Begin
  3641.      List.Clear;
  3642.  
  3643.      If FieldCount=0 Then
  3644.      Begin
  3645.           If ((Designed)And(Not FOpened)) Then
  3646.           Begin
  3647.                FActive:=True;
  3648.                DoOpen;
  3649.                If Not FOpened Then FActive:=False
  3650.                Else RefreshTable;
  3651.           End
  3652.           Else RefreshTable;
  3653.      End;
  3654.  
  3655.      For T:=0 To FieldCount-1 Do List.Add(FieldNames[T]);
  3656. End;
  3657.  
  3658.  
  3659. Procedure TDataSet.Delete;
  3660. Begin
  3661.      If Not FOpened Then Exit;
  3662.      If (CurrentRow < 0) Or (CurrentRow >= RecordCount) Then exit;
  3663.  
  3664.      Try
  3665.         If FBeforeDelete <> Nil Then FBeforeDelete(Self);
  3666.  
  3667.         If FRowIsInserted Then CommitInsert(False)
  3668.         Else DoDelete;
  3669.  
  3670.         DataChange(deDataBaseChanged);
  3671.  
  3672.         If FAfterDelete <> Nil Then FAfterDelete(Self);
  3673.      Except
  3674.         Raise;
  3675.      End;
  3676. End;
  3677.  
  3678.  
  3679. Procedure TDataSet.DoDelete;
  3680. Begin
  3681.      RemoveCurrentFields;
  3682. End;
  3683.  
  3684.  
  3685. Procedure TDataSet.Append;
  3686. Begin
  3687.      Insert;
  3688. End;
  3689.  
  3690.  
  3691. Procedure TDataSet.Insert;
  3692. Begin
  3693.      If Not FOpened Then Exit;
  3694.  
  3695.      Try
  3696.         If FBeforeInsert <> Nil Then FBeforeInsert(Self);
  3697.  
  3698.         If FRowIsInserted Then CommitInsert(True);
  3699.  
  3700.         DoInsert;
  3701.  
  3702.         DataChange(deDataBaseChanged);
  3703.  
  3704.         If FAfterInsert <> Nil Then FAfterInsert(Self);
  3705.      Except
  3706.         Raise;
  3707.      End;
  3708. End;
  3709.  
  3710.  
  3711. Procedure TDataSet.DoInsert;
  3712. Begin
  3713.      If FCurrentRow < 0 Then FCurrentRow := 0; //empty table
  3714.  
  3715.      InsertCurrentFields;
  3716.  
  3717.      FRowIsInserted := True;
  3718. End;
  3719.  
  3720.  
  3721. Procedure TDataSet.InsertCurrentFields;
  3722. Var  Col,Row:LongInt;
  3723.      FieldDef:TFieldDef;
  3724.      Field:TField;
  3725. Begin
  3726.      For Col := 0 To FFieldDefs.Count-1 Do
  3727.      Begin
  3728.           FieldDef := FFieldDefs[Col];
  3729.           Field := FieldDef.CreateField(Nil);
  3730.           //Field.Clear;
  3731.           If Field.FValue<>Nil Then FreeMem(Field.FValue,Field.FValueLen);
  3732.           Field.FValue:=Nil;
  3733.           Field.FValueLen:=0;
  3734.           Field.FRow := FCurrentRow;
  3735.           Field.FCol := Col;
  3736.           FieldDef.Fields.Insert(FCurrentRow,Field);
  3737.  
  3738.           For Row := FCurrentRow+1 To FieldDef.Fields.Count-1 Do
  3739.           Begin
  3740.                Field := FieldDef.Fields[Row];
  3741.                If Field <> Nil Then Inc(Field.FRow);
  3742.           End;
  3743.      End;
  3744. End;
  3745.  
  3746.  
  3747. Const Months:Array[1..12] Of String[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul',
  3748.                                         'Aug','Sep','Oct','Nov','Dec');
  3749.  
  3750. Function Field2String(field:TField):String;
  3751. Var
  3752.     dt:TDateTime;
  3753.     Year,Month,Day,Hour,Min,Sec:Word;
  3754.     s,s1,s2:String;
  3755. Begin
  3756.      If field.IsNull Then
  3757.      Begin
  3758.           Result:='NULL';
  3759.           Exit;
  3760.      End;
  3761.  
  3762.      Case field.DataType Of
  3763.         ftDate:
  3764.         Begin
  3765.              dt:=field.GetAsDateTime;
  3766.              DecodeDate(dt,Year,Month,Day);
  3767.              If Field.FDataSet.FDBProcs.DBType=Native_mSQL Then
  3768.                Result:=tostr(Day)+'-'+Months[Month]+'-'+tostr(Year)
  3769.              Else
  3770.                Result:=tostr(Year)+'-'+tostr(Month)+'-'+tostr(Day);
  3771.         End;
  3772.         ftTime:
  3773.         Begin
  3774.              dt:=field.GetAsDateTime;
  3775.              RoundDecodeTime(dt,Hour,Min,Sec);
  3776.              If Field.FDataSet.FDBProcs.DBType=Native_mSQL Then
  3777.                Result:=tostr(Hour)+':'+tostr(Min)+':'+tostr(Sec)
  3778.              Else
  3779.                Result:=tostr(Hour)+'.'+tostr(Min)+'.'+tostr(Sec);
  3780.         End;
  3781.         ftDateTime:
  3782.         Begin
  3783.              dt:=field.GetAsDateTime;
  3784.              DecodeDate(dt,Year,Month,Day);
  3785.              RoundDecodeTime(dt,Hour,Min,Sec);
  3786.              If Field.FDataSet.FDBProcs.DBType=Native_Oracle7 Then
  3787.              Begin
  3788.                   s:=tostr(Year);
  3789.                   While length(s)<4 Do s:='0'+s;
  3790.                   s1:=tostr(Month);
  3791.                   If length(s1)<2 Then s1:='0'+s1;
  3792.                   s2:=tostr(Day);
  3793.                   If length(s2)<2 Then s2:='0'+s2;
  3794.                   Result:='TO_DATE('#39+s+'-'+s1+'-'+s2;
  3795.                   s:=tostr(Hour);
  3796.                   If length(s)<2 Then s:='0'+s;
  3797.                   s1:=tostr(Min);
  3798.                   If length(s1)<2 Then s1:='0'+s1;
  3799.                   s2:=tostr(Sec);
  3800.                   If length(s2)<2 Then s2:='0'+s2;
  3801.                   Result:=Result+' '+s+'.'+s1+'.'+s2;
  3802.                   Result:=Result+#39','#39'YYYY-MM-DD HH24.MI.SS'#39')';
  3803.                   exit;
  3804.              End
  3805.              Else
  3806.              Begin
  3807.                 Result:=tostr(Year)+'-'+tostr(Month)+'-'+tostr(Day);
  3808.                 Result:=Result+'-'+tostr(Hour)+'.'+tostr(Min)+'.';
  3809.                 Result:=Result+tostr(Sec)+'.00';
  3810.              End;
  3811.         End;
  3812.         ftMemo:
  3813.         Begin
  3814.              Result:=PChar(Field.FValue)^;
  3815.         End;
  3816.         ftFloat:
  3817.         Begin
  3818.              Result:=field.AsString;
  3819.              //eliminate decimal separator
  3820.              If pos(',',Result)<>0 Then Result[pos(',',Result)]:='.';
  3821.  
  3822.         End;
  3823.         Else Result:=field.AsString;
  3824.      End; {Case}
  3825.  
  3826.      If Not (field.DataType In [ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency]) Then
  3827.        Result:=#39+Result+#39;
  3828. End;
  3829.  
  3830.  
  3831. Procedure TDataSet.CommitInsert(Commit:Boolean);
  3832. Begin
  3833. End;
  3834.  
  3835.  
  3836. Procedure TDataSet.RemoveCurrentFields;
  3837. Var  Col,Row:LongInt;
  3838.      Field:TField;
  3839.      FieldDef:TFieldDef;
  3840. Begin
  3841.      FieldDef := Nil;
  3842.  
  3843.      For Col := 0 To FFieldDefs.Count-1 Do
  3844.      Begin
  3845.           FieldDef := FFieldDefs[Col];
  3846.           Field := FieldDef.Fields[FCurrentRow];
  3847.           If Field <> Nil Then
  3848.           Begin
  3849.                FieldDef.Fields.Remove(Field);
  3850.                Field.Destroy;
  3851.           End;
  3852.  
  3853.           For Row := FCurrentRow To FieldDef.Fields.Count-1 Do
  3854.           Begin
  3855.                Field := FieldDef.Fields[Row];
  3856.                If Field <> Nil Then Dec(Field.FRow);
  3857.           End;
  3858.      End;
  3859.  
  3860.      If FieldDef <> Nil Then
  3861.        If FCurrentRow >= FieldDef.Fields.Count
  3862.        Then FCurrentRow := FieldDef.Fields.Count-1;
  3863. End;
  3864.  
  3865.  
  3866. Function TDataSet.UpdateFieldSelect(Field:TField):Boolean;
  3867. Begin
  3868.      Result:=False;
  3869. End;
  3870.  
  3871.  
  3872. Procedure TDataSet.UpdateField(field:TField;OldValue:Pointer;OldValueLen:LongInt);
  3873. Begin
  3874.      If Not FOpened Then Exit;
  3875.      If FSelect.Count=0 Then Exit;  //Nothing To Select
  3876.      Try
  3877.         If Not UpdateFieldSelect(field) Then
  3878.         Begin
  3879.              FreeMem(field.FValue,field.FValueLen);
  3880.              field.FValue:=OldValue;
  3881.              field.FValueLen:=OldValueLen;
  3882.         End
  3883.         Else FreeMem(OldValue,OldValueLen);
  3884.      Except
  3885.         FreeMem(field.FValue,field.FValueLen);
  3886.         field.FValue:=OldValue;
  3887.         field.FValueLen:=OldValueLen;
  3888.         Raise;
  3889.      End;
  3890. End;
  3891.  
  3892.  
  3893. Procedure TDataSet.Post;
  3894. Begin
  3895.      If Not FOpened Then Exit;
  3896.      If (CurrentRow < 0) Or (CurrentRow >= RecordCount) Then exit;
  3897.  
  3898.      Try
  3899.         CheckRequiredFields;
  3900.  
  3901.         If FBeforePost <> Nil Then FBeforePost(Self);
  3902.  
  3903.         If FRowIsInserted Then CommitInsert(True)
  3904.         Else DoPost;
  3905.  
  3906.         DataChange(deDataBaseChanged);
  3907.  
  3908.         If FAfterPost <> Nil Then FAfterPost(Self);
  3909.      Except
  3910.         Raise;
  3911.      End;
  3912. End;
  3913.  
  3914.  
  3915. Procedure TDataSet.DoPost;
  3916. Begin
  3917. End;
  3918.  
  3919.  
  3920. Procedure TDataSet.Cancel;
  3921. Begin
  3922.      If Not FOpened Then Exit;
  3923.      If (CurrentRow < 0) Or (CurrentRow >= RecordCount) Then exit;
  3924.  
  3925.      Try
  3926.         If FBeforeCancel <> Nil Then FBeforeCancel(Self);
  3927.  
  3928.         If FRowIsInserted Then CommitInsert(False)
  3929.         Else DoCancel;
  3930.  
  3931.         DataChange(deDataBaseChanged);
  3932.  
  3933.         If FAfterCancel <> Nil Then FAfterCancel(Self);
  3934.      Except
  3935.         Raise;
  3936.      End;
  3937. End;
  3938.  
  3939.  
  3940. Procedure TDataSet.DoCancel;
  3941. Begin
  3942. End;
  3943.  
  3944.  
  3945. Procedure TDataSet.QueryTable;
  3946. Begin
  3947. End;
  3948.  
  3949.  
  3950. Procedure TDataSet.Loaded;
  3951. Begin
  3952.      Inherited Loaded;
  3953.  
  3954.      If FRefreshOnLoad Then Active:=True;
  3955. End;
  3956.  
  3957.  
  3958. Procedure TDataSet.CheckInactive;
  3959. Begin
  3960.      If Active Then
  3961.      Begin
  3962.           //Close;
  3963.           DatabaseError('Cannot perform this operation on active dataset !');
  3964.      End;
  3965. End;
  3966.  
  3967.  
  3968. Function TDataSet.IsTable:Boolean;
  3969. Begin
  3970.      Result := (Self Is TTable) And (Not (Self Is TQuery)) And (Not (Self Is TStoredProc));
  3971. End;
  3972.  
  3973.  
  3974. {
  3975. ╔═══════════════════════════════════════════════════════════════════════════╗
  3976. ║                                                                           ║
  3977. ║ Speed-Pascal/2 Version 2.0                                                ║
  3978. ║                                                                           ║
  3979. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3980. ║                                                                           ║
  3981. ║ This section: TTable Class Implementation                                 ║
  3982. ║                                                                           ║
  3983. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3984. ║                                                                           ║
  3985. ╚═══════════════════════════════════════════════════════════════════════════╝
  3986. }
  3987.  
  3988. Procedure TTable.GetPrimaryKeys(List:TStrings);
  3989. Begin
  3990.      GetKeys(List,True);
  3991. End;
  3992.  
  3993. Function MapODBCType(colType:TFieldType):SQLSMALLINT;
  3994. Begin
  3995.      Case colType Of
  3996.          ftString:Result:=SQL_VARCHAR;
  3997.          ftCurrency:Result:=SQL_NUMERIC;
  3998.          ftInteger:Result:=SQL_INTEGER;
  3999.          ftSmallInt:Result:=SQL_SMALLINT;
  4000.          ftFloat:Result:=SQL_DOUBLE;
  4001.          ftDate:Result:=SQL_DATE;
  4002.          ftTime:Result:=SQL_TIME;
  4003.          ftDateTime:Result:=SQL_TIMESTAMP;
  4004.          ftMemo:Result:=SQL_LONGVARCHAR;
  4005.          ftBlob:Result:=SQL_VARBINARY;
  4006.          ftGraphic:Result:=SQL_VARGRAPHIC;
  4007.          Else Result:=SQL_BLOB;
  4008.      End; {Case}
  4009. End;
  4010.  
  4011. Function TTable.DataType2Name(DataType:TFieldType):String;
  4012. Var List:TStringList;
  4013.     t:LongInt;
  4014. Begin
  4015.     Result:='';
  4016.  
  4017.     Case FDBProcs.DBType Of
  4018.        Native_Oracle7:
  4019.        Begin
  4020.             Case DataType Of
  4021.                ftString:Result:='VARCHAR2';
  4022.                ftSmallInt,ftInteger,ftWord:Result:='INT';
  4023.                ftBoolean:Result:='CHAR';
  4024.                ftFloat,ftCurrency:Result:='FLOAT';
  4025.                ftDate,ftTime,ftDateTime:Result:='DATE';
  4026.                ftBytes,ftBlob,ftMemo,ftGraphic,ftFmtMemo,
  4027.                ftTypedBinary:Result:='RAW';
  4028.                ftVarBytes:Result:='LONG RAW';
  4029.             End;
  4030.        End;
  4031.        Native_msql:
  4032.        Begin
  4033.             Case DataType Of
  4034.                ftString:Result:='CHAR';
  4035.                ftSmallInt,ftInteger,ftWord:Result:='INT';
  4036.                ftBoolean:Result:='CHAR';
  4037.                ftFloat,ftCurrency:Result:='REAL';
  4038.                ftDate:Result:='DATE';
  4039.                ftTime:Result:='TIME';
  4040.                ftMemo,ftFmtMemo:Result:='TEXT';
  4041.             End;
  4042.        End;
  4043.        Native_DBase:
  4044.        Begin
  4045.             Case DataType Of
  4046.                ftString: Result := 'CHAR';
  4047.                ftDate: Result := 'DATE';
  4048.                ftFloat,ftCurrency: Result := 'FLOAT';
  4049.                ftSmallInt,ftInteger,ftWord: Result := 'INT';
  4050.                ftBoolean: Result := 'BOOL';
  4051.                ftMemo: Result := 'TEXT';
  4052.                ftBlob: Result := 'BLOB';
  4053.                Else Result := '';
  4054.             End;
  4055.        End;
  4056.        Native_Paradox:
  4057.        Begin
  4058.             Case DataType Of
  4059.               ftString: Result := 'CHAR';
  4060.               ftDate: Result := 'DATE';
  4061.               ftSmallInt: Result := 'SINT';
  4062.               ftInteger: Result := 'INT';
  4063.               ftFloat: Result := 'FLOAT';
  4064.               ftCurrency: Result := 'MONEY';
  4065.               //ftInteger: Result := 'NUMBER';
  4066.               ftBoolean: Result := 'BOOL';
  4067.               ftMemo: Result := 'TEXT';
  4068.               ftBlob: Result := 'BLOB';
  4069.               ftFmtMemo: Result := 'FMTTEXT';
  4070.               ftTime: Result := 'TIME';
  4071.               ftDateTime: Result := 'DATETIME';
  4072.               ftAutoInc: Result := 'AUTOINC';
  4073.               ftBCD: Result := 'BCD';
  4074.               ftBytes: Result := 'BYTES';
  4075.               Else Result := '';
  4076.             End;
  4077.        End;
  4078.        Else
  4079.        Begin
  4080.             If FDataTypes=Nil Then
  4081.             Begin
  4082.                  List.Create;
  4083.                  GetDataTypes(List);
  4084.                  List.Destroy;
  4085.             End;
  4086.  
  4087.             Result:='';
  4088.             If FDataTypes=Nil Then exit;
  4089.             For t:=0 To FDataTypes.Count-1 Do
  4090.              If TFieldType(FDataTypes.Objects[t])=DataType Then
  4091.              Begin
  4092.                   Result:=FDataTypes[t];
  4093.                   exit;
  4094.              End;
  4095.        End;
  4096.     End; //case
  4097. End;
  4098.  
  4099. Function TTable.GetIndexDefs:TIndexDefs;
  4100. Begin
  4101.      If ((FIndexDefs=Nil)Or(FIndexDefs.Count=0)) Then UpdateIndexDefs;
  4102.      Result:=FIndexDefs;
  4103. End;
  4104.  
  4105. Procedure UpdateIndexFieldMap(Table:TTable);
  4106. Var t,Index:LongInt;
  4107.     IndexDef:TIndexDef;
  4108.     s,s1:String;
  4109. Begin
  4110.      If Table.FIndexFieldMap<>Nil Then Table.FIndexFieldMap.Clear
  4111.      Else Table.FIndexFieldMap.Create;
  4112.  
  4113.      For t:=0 To Table.IndexDefs.Count-1 Do
  4114.      Begin
  4115.           IndexDef:=Table.IndexDefs[t];
  4116.  
  4117.           s:=IndexDef.Fields;
  4118.           While pos(';',s)<>0 Do
  4119.           Begin
  4120.                s1:=Copy(s,1,pos(';',s)-1);
  4121.                System.Delete(s,1,pos(';',s));
  4122.  
  4123.                Index:=Table.FieldDefs.IndexOf(s1);
  4124.                If Index>=0 Then If Table.FIndexFieldMap.IndexOf(Pointer(Index))<0 Then
  4125.                  Table.FIndexFieldMap.Add(Pointer(Index));
  4126.           End;
  4127.           If s<>'' Then
  4128.           Begin
  4129.                Index:=Table.FieldDefs.IndexOf(s);
  4130.                If Index>=0 Then If Table.FIndexFieldMap.IndexOf(Pointer(Index))<0 Then
  4131.                  Table.FIndexFieldMap.Add(Pointer(Index));
  4132.           End;
  4133.      End;
  4134. End;
  4135.  
  4136. Function TTable.GetIndexFieldCount:LongInt;
  4137. Begin
  4138.      If ((FIndexFieldMap=Nil)Or(FIndexFieldMap.Count=0)) Then UpdateIndexFieldMap(Self);
  4139.      Result:=FIndexFieldMap.Count
  4140. End;
  4141.  
  4142. Function TTable.GetIndexField(Index:LongInt):TField;
  4143. Begin
  4144.      If ((FIndexFieldMap=Nil)Or(FIndexFieldMap.Count=0)) Then UpdateIndexFieldMap(Self);
  4145.      Result:=Fields[LongInt(FIndexFieldMap[Index])]
  4146. End;
  4147.  
  4148. Procedure TTable.SetIndexField(Index:LongInt;NewValue:TField);
  4149. Begin
  4150.      GetIndexField(Index).Assign(NewValue);
  4151. End;
  4152.  
  4153. Procedure TTable.AddIndex(Const Name:String;Fields:String;Options:TIndexOptions);
  4154. Var OldActive,OldOpen:Boolean;
  4155.     S1,s2:String;
  4156.     ahstmt:SQLHSTMT;
  4157. Begin
  4158.      If (Not IsTable) Then SQLError('Illegal operation');
  4159.  
  4160.      OldActive:=FActive;
  4161.      OldOpen:=FOpened;
  4162.      If Not FOpened Then
  4163.      Begin
  4164.           FActive:=True;
  4165.           DoOpen;
  4166.           If Not FOpened Then Active:=False;
  4167.      End;
  4168.  
  4169.      s1:='CREATE';
  4170.      If Options*[ixUnique]<>[] Then s1:=s1+' UNIQUE';
  4171.      s1:=s1+' INDEX '+Name+' ON '+TableName+'(';
  4172.      While pos(';',Fields)<>0 Do
  4173.      Begin
  4174.           s2:=Copy(Fields,1,pos(';',Fields)-1);
  4175.           System.Delete(Fields,1,pos(';',Fields));
  4176.           If s1[length(s1)]<>'(' Then s1:=s1+',';
  4177.           s1:=s1+s2;
  4178.           If FDBProcs.DBType<>Native_Msql Then
  4179.           Begin
  4180.              If Options*[ixDescending]<>[] Then s1:=s1+' DESC'
  4181.              Else s1:=s1+' ASC';
  4182.           End;
  4183.      End;
  4184.      If s1[length(s1)]<>'(' Then s1:=s1+',';
  4185.      s1:=s1+Fields;
  4186.      If FDBProcs.DBType<>Native_Msql Then
  4187.      Begin
  4188.           If Options*[ixDescending]<>[] Then s1:=s1+' DESC'
  4189.           Else s1:=s1+' ASC';
  4190.      End;
  4191.      s1:=s1+')';
  4192.  
  4193.      If FOpened Then
  4194.      Begin
  4195.           EnterSQLProcessing;
  4196.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4197.  
  4198.           If FDBProcs.SQLExecDirect(ahstmt,s1,SQL_NTS)<>SQL_SUCCESS Then
  4199.           Begin
  4200.                S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4201.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4202.                SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4203.           End;
  4204.  
  4205.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4206.           LeaveSQLProcessing;
  4207.      End;
  4208.  
  4209.      DoPost;
  4210.      If not OldOpen Then DoClose;
  4211.      FActive:=OldActive;
  4212.      UpdateIndexDefs;
  4213. End;
  4214.  
  4215. Procedure TTable.DeleteIndex(Const Name: string);
  4216. Var OldActive,OldOpen:Boolean;
  4217.     S1:String;
  4218.     ahstmt:SQLHSTMT;
  4219. Begin
  4220.      If (Not IsTable) Then SQLError('Illegal operation');
  4221.  
  4222.      OldActive:=FActive;
  4223.      OldOpen:=FOpened;
  4224.      If Not FOpened Then
  4225.      Begin
  4226.           FActive:=True;
  4227.           DoOpen;
  4228.           If Not FOpened Then Active:=False;
  4229.      End;
  4230.  
  4231.      If FOpened Then
  4232.      Begin
  4233.           EnterSQLProcessing;
  4234.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4235.  
  4236.           s1:='DROP INDEX '+Name;
  4237.           If FDBProcs.DBType=Native_msql Then s1:=s1+' FROM '+TableName;
  4238.           If FDBProcs.SQLExecDirect(ahstmt,s1,SQL_NTS)<>SQL_SUCCESS Then
  4239.           Begin
  4240.                S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4241.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4242.                SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4243.           End;
  4244.  
  4245.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4246.           LeaveSQLProcessing;
  4247.      End;
  4248.  
  4249.      DoPost;
  4250.      If not OldOpen Then DoClose;
  4251.      FActive:=OldActive;
  4252.      UpdateIndexDefs;
  4253. End;
  4254.  
  4255.  
  4256. Procedure TTable.CreateTable;
  4257. Var s:AnsiString;
  4258.     s1:String;
  4259.     ahstmt:SQLHSTMT;
  4260.     t:LongInt;
  4261.     FieldDef:TFieldDef;
  4262.     OldActive:Boolean;
  4263. Begin
  4264.      If (Not IsTable) Then SQLError('Illegal operation');
  4265.  
  4266.      CheckInactive;
  4267.  
  4268.      s:='CREATE TABLE '+TableName+'(';
  4269.  
  4270.      For t:=0 To FieldDefs.Count-1 Do
  4271.      Begin
  4272.           FieldDef:=FieldDefs[t];
  4273.           s1:=FieldDef.TypeName;
  4274.           s:=s+FieldDef.Name+' '+s1;
  4275.           If ((FieldDef.DataType=ftString)Or(s1='LONG RAW')) Then
  4276.             s:=s+'('+tostr(FieldDef.Size)+')';
  4277.           If FieldDef.Required then s:=s+' NOT NULL';
  4278.           If FieldDef.PrimaryKey Then s:=s+' PRIMARY KEY';
  4279.           If FieldDef.ForeignKey<>'' Then s:=s+' REFERENCES '+FieldDef.ForeignKey;
  4280.           If t<>FieldDefs.Count-1 Then s:=s+',';
  4281.      End;
  4282.  
  4283.      s:=s+')';
  4284.  
  4285.      OldActive:=FActive;
  4286.      If Not FOpened Then
  4287.      Begin
  4288.           FActive:=True;
  4289.           DoOpen;
  4290.           If Not FOpened Then Active:=False;
  4291.      End;
  4292.  
  4293.      If FOpened Then
  4294.      Begin
  4295.          EnterSQLProcessing;
  4296.          FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4297.  
  4298.          If FDBProcs.SQLExecDirect(ahstmt,PChar(s)^,SQL_NTS)<>SQL_SUCCESS Then
  4299.          Begin
  4300.              S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4301.              FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4302.              SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4303.          End;
  4304.  
  4305.          FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4306.          LeaveSQLProcessing;
  4307.      End;
  4308.      DoClose;
  4309.      FActive:=OldActive;
  4310. End;
  4311.  
  4312.  
  4313. Procedure TTable.DeleteTable;
  4314. Var s1:String;
  4315.     ahstmt:SQLHSTMT;
  4316. Begin
  4317.      If (Not IsTable) Then SQLError('Illegal operation');
  4318.      If Active Then DoClose;
  4319.  
  4320.      If Not FOpened Then
  4321.      Begin
  4322.           FActive:=True;
  4323.           DoOpen;
  4324.           If Not FOpened Then Active:=False;
  4325.      End;
  4326.  
  4327.      If FOpened Then
  4328.      Begin
  4329.           EnterSQLProcessing;
  4330.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4331.  
  4332.           If FDBProcs.SQLExecDirect(ahstmt,'DROP TABLE '+TableName,SQL_NTS)<>SQL_SUCCESS Then
  4333.           Begin
  4334.                S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4335.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4336.                SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4337.           End;
  4338.  
  4339.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4340.           LeaveSQLProcessing;
  4341.      End;
  4342.  
  4343.      DoPost;
  4344.      DoClose;
  4345. End;
  4346.  
  4347.  
  4348. Procedure TTable.EmptyTable;
  4349. Var OldActive,OldOpen:Boolean;
  4350.     S1:String;
  4351.     ahstmt:SQLHSTMT;
  4352. Begin
  4353.      If (Not IsTable) Then SQLError('Illegal operation');
  4354.  
  4355.      OldActive:=FActive;
  4356.      OldOpen:=FOpened;
  4357.      If Not FOpened Then
  4358.      Begin
  4359.           FActive:=True;
  4360.           DoOpen;
  4361.           If Not FOpened Then Active:=False;
  4362.      End;
  4363.  
  4364.      If FOpened Then
  4365.      Begin
  4366.           EnterSQLProcessing;
  4367.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4368.  
  4369.           If FDBProcs.SQLExecDirect(ahstmt,'DELETE * FROM '+TableName,SQL_NTS)<>SQL_SUCCESS Then
  4370.           Begin
  4371.                S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4372.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4373.                SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4374.           End;
  4375.  
  4376.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4377.           LeaveSQLProcessing;
  4378.      End;
  4379.  
  4380.      DoPost;
  4381.      If not OldOpen Then DoClose;
  4382.      FActive:=OldActive;
  4383. End;
  4384.  
  4385.  
  4386. Function TTable.FindKey(Const KeyValues:Array of Const):Boolean;
  4387. Begin
  4388.      If (Not IsTable) Then SQLError('Illegal operation');
  4389.      Result:=False;
  4390.      //???
  4391. End;
  4392.  
  4393. Procedure TTable.GetIndexNames(List: TStrings);
  4394. Var t:LongInt;
  4395. Begin
  4396.      List.Clear;
  4397.      For t:=0 To IndexDefs.Count-1 Do List.Add(IndexDefs[t].Name);
  4398. End;
  4399.  
  4400. Procedure TTable.RenameTable(NewTableName:String);
  4401. Var OldActive,OldOpen:Boolean;
  4402.     S1:String;
  4403.     ahstmt:SQLHSTMT;
  4404.     tn:String;
  4405. Begin
  4406.      If (Not IsTable) Then SQLError('Illegal operation');
  4407.  
  4408.      OldActive:=FActive;
  4409.      OldOpen:=FOpened;
  4410.      If Not FOpened Then
  4411.      Begin
  4412.           FActive:=True;
  4413.           DoOpen;
  4414.           If Not FOpened Then Active:=False;
  4415.      End;
  4416.  
  4417.      If FOpened Then
  4418.      Begin
  4419.           EnterSQLProcessing;
  4420.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4421.  
  4422.           tn:=TableName;
  4423.           If FDBProcs.DBType=Native_Oracle7 Then //no qualifiers !
  4424.           Begin
  4425.                If pos('.',NewTableName)<>0 Then
  4426.                  System.Delete(NewTableName,1,pos('.',NewTableName));
  4427.  
  4428.                If pos('.',tn)<>0 Then
  4429.                  System.Delete(tn,1,pos('.',tn));
  4430.           End;
  4431.  
  4432.           If FDBProcs.DBType=Native_Oracle7 Then s1:='RENAME '+tn+' TO '+NewTableName
  4433.           Else s1:='ALTER TABLE '+TableName+' RENAME '+NewTableName;
  4434.           If FDBProcs.SQLExecDirect(ahstmt,s1,SQL_NTS)<>SQL_SUCCESS Then
  4435.           Begin
  4436.                S1:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4437.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4438.                SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S1);
  4439.           End;
  4440.  
  4441.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4442.           LeaveSQLProcessing;
  4443.      End;
  4444.  
  4445.      DoPost;
  4446.      DoClose;
  4447.      TableName:=NewTableName;
  4448.      FActive:=OldActive;
  4449. End;
  4450.  
  4451.  
  4452. Procedure TTable.GetNames(List:TStrings;Const Name:String);
  4453. Var
  4454.    ahstmt:SQLHSTMT;
  4455.    cols:SQLSMALLINT;
  4456.    I:LongInt;
  4457.    C:Array[0..4] Of cstring;
  4458.    OutLen:Array[0..4] Of SQLINTEGER;
  4459.    rc:SQLRETURN;
  4460.    S,S1:String;
  4461.    OldActive:Boolean;
  4462.    OldOpen:Boolean;
  4463.    Index:LongInt;
  4464. Begin
  4465.      List.Clear;
  4466.  
  4467.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  4468.      Begin
  4469.           OldActive:=FActive;
  4470.           OldOpen:=FOpened;
  4471.           If Not FOpened Then
  4472.           Begin
  4473.                FActive:=True;
  4474.                DoOpen;
  4475.                If Not FOpened Then Active:=False;
  4476.           End;
  4477.  
  4478.           If FOpened Then
  4479.           Begin
  4480.                EnterSQLProcessing;
  4481.                FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4482.  
  4483.                If FDBProcs.SQLTables(ahstmt,Nil,0,Nil,0,Nil,0,Name,SQL_NTS)=SQL_SUCCESS Then
  4484.                Begin
  4485.                     FDBProcs.SQLNumResultCols(ahstmt,cols);
  4486.                     If cols>5 Then cols:=5;
  4487.                     For I := 0 To cols-1 Do
  4488.                       FDBProcs.SQLBindCol(ahstmt, I + 1, SQL_C_CHAR, C[I], 255, OutLen[I]);
  4489.                     rc:=FDBProcs.SQLFetch(ahstmt);
  4490.                     While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  4491.                     Begin
  4492.                          If Cols=1 Then Index:=0 //msql
  4493.                          Else Index:=2;
  4494.  
  4495.                          If OutLen[Index]<>SQL_NULL_DATA Then
  4496.                          Begin
  4497.                               Move(C[Index],S[1],OutLen[Index]);
  4498.                               S[0]:=Chr(OutLen[Index]);
  4499.                               If S[length(s)]=#0 Then
  4500.                                If length(S)>0 Then dec(S[0]);
  4501.                               If Cols>1 Then //get qualifier
  4502.                                If OutLen[0]<>SQL_NULL_DATA Then
  4503.                               Begin
  4504.                                    Move(C[0],S1[1],OutLen[0]);
  4505.                                    S1[0]:=Chr(OutLen[0]);
  4506.                                    If S1[length(S1)]=#0 Then
  4507.                                     If length(S1)>0 Then dec(S1[0]);
  4508.                                    If S1<>'' Then S:=S1+'.'+S;
  4509.                               End;
  4510.                               List.Add(S);
  4511.                          End;
  4512.                          rc:=FDBProcs.SQLFetch(ahstmt);
  4513.                     End;
  4514.                End;
  4515.  
  4516.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4517.                LeaveSQLProcessing;
  4518.           End;
  4519.  
  4520.           If Not OldOpen Then DoClose;
  4521.           FActive:=OldActive;
  4522.      End;
  4523.  
  4524. End;
  4525.  
  4526. Procedure TTable.GetViewNames(List:TStrings);
  4527. Begin
  4528.      GetNames(List,'VIEW');
  4529. End;
  4530.  
  4531. Procedure TTable.GetSystemTableNames(List:TStrings);
  4532. Begin
  4533.      GetNames(List,'SYSTEM TABLE');
  4534. End;
  4535.  
  4536. Procedure TTable.GetSynonymNames(List:TStrings);
  4537. Begin
  4538.      GetNames(List,'SYNONYM');
  4539. End;
  4540.  
  4541. Function MapSQLType(colType:SQLSMALLINT):TFieldType;
  4542. Begin
  4543.      Case colType Of
  4544.          SQL_CHAR:Result:=ftString;
  4545.          SQL_NUMERIC:Result:=ftFloat;
  4546.          SQL_DECIMAL:Result:=ftFloat;
  4547.          SQL_INTEGER:Result:=ftInteger;
  4548.          SQL_SMALLINT:Result:=ftSmallInt;
  4549.          SQL_FLOAT:Result:=ftFloat;
  4550.          SQL_REAL:Result:=ftFloat;
  4551.          SQL_DOUBLE:Result:=ftFloat;
  4552.          SQL_DATE:Result:=ftDate;
  4553.          SQL_TIME:Result:=ftTime;
  4554.          SQL_TIMESTAMP:Result:=ftDateTime;
  4555.          SQL_VARCHAR:Result:=ftString;
  4556.          SQL_LONGVARCHAR:Result:=ftMemo;
  4557.          SQL_BINARY:Result:=ftBlob;
  4558.          SQL_VARBINARY:Result:=ftBlob;
  4559.          SQL_LONGVARBINARY:Result:=ftBlob;
  4560.          {SQL_BIGINT             =-5;  /* Not supported */
  4561.          SQL_TINYINT            =-6;  /* Not supported */}
  4562.          SQL_BIT:Result:=ftBoolean;
  4563.          SQL_GRAPHIC:Result:=ftGraphic;
  4564.          SQL_VARGRAPHIC:Result:=ftGraphic;
  4565.          SQL_LONGVARGRAPHIC:Result:=ftGraphic;
  4566.          SQL_BLOB:Result:=ftBlob;
  4567.          SQL_CLOB:Result:=ftBlob;
  4568.          SQL_DBCLOB:Result:=ftBlob;
  4569.          Else Result:=ftUnknown;
  4570.      End; {Case}
  4571. End;
  4572.  
  4573.  
  4574. Procedure TTable.GetDataTypes(List:TStrings);
  4575. Var
  4576.    OldActive:Boolean;
  4577.    OldOpen:Boolean;
  4578.    Index:LongInt;
  4579.  
  4580.    Procedure GetType(Typ:SQLSMALLINT);
  4581.    Var cols:SQLSMALLINT;
  4582.        I:LongInt;
  4583.        C:cstring;
  4584.        OutLen:SQLINTEGER;
  4585.        rc:SQLRETURN;
  4586.        S,S1:String;
  4587.        ahstmt:SQLHSTMT;
  4588.    Begin
  4589.         EnterSQLProcessing;
  4590.         FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4591.  
  4592.         If FDBProcs.SQLGetTypeInfo(ahstmt,Typ)=SQL_SUCCESS Then
  4593.         Begin
  4594.              FDBProcs.SQLNumResultCols(ahstmt,cols);
  4595.              If cols=0 Then exit;
  4596.              FDBProcs.SQLBindCol(ahstmt, 1, SQL_C_CHAR, C, 255, OutLen);
  4597.              rc:=FDBProcs.SQLFetch(ahstmt);
  4598.              If ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Then
  4599.              Begin
  4600.                   If OutLen<>SQL_NULL_DATA Then
  4601.                   Begin
  4602.                        Move(C,S[1],OutLen);
  4603.                        S[0]:=Chr(OutLen);
  4604.                        If S[length(s)]=#0 Then
  4605.                         If length(s)>0 Then dec(S[0]);
  4606.                        UpcaseStr(S);
  4607.                        If List.IndexOf(S)<0 Then List.AddObject(S,Pointer(MapSQLType(Typ)));
  4608.                   End;
  4609.              End;
  4610.         End;
  4611.  
  4612.         FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4613.         LeaveSQLProcessing;
  4614.    End;
  4615.  
  4616.    Procedure ListAddObject(Const s:String;DataType:TFieldType);
  4617.    Begin
  4618.         List.AddObject(s,Pointer(DataType));
  4619.    End;
  4620.  
  4621. Begin
  4622.      List.Clear;
  4623.      Case FDBProcs.DBType Of
  4624.         Native_Oracle7:
  4625.         Begin
  4626.              ListAddObject('CHAR',ftString);
  4627.              ListAddObject('VARCHAR2',ftString);
  4628.              ListAddObject('FLOAT',ftFloat);
  4629.              ListAddObject('INT',ftInteger);
  4630.              ListAddObject('DATE',ftDateTime);
  4631.              ListAddObject('RAW',ftBlob);
  4632.              ListAddObject('LONG RAW',ftBlob);
  4633.         End;
  4634.         Native_msql:
  4635.         Begin
  4636.              ListAddObject('CHAR',ftString);
  4637.              ListAddObject('INT',ftInteger);
  4638.              ListAddObject('UINT',ftInteger);
  4639.              ListAddObject('REAL',ftFloat);
  4640.              ListAddObject('TEXT',ftMemo);
  4641.              ListAddObject('DATE',ftDate);
  4642.              ListAddObject('TIME',ftTime);
  4643.              ListAddObject('MONEY',ftInteger);
  4644.         End;
  4645.         Native_DBase:
  4646.         Begin
  4647.              ListAddObject('CHAR',ftString);
  4648.              ListAddObject('INT',ftInteger);
  4649.              ListAddObject('FLOAT',ftFloat);
  4650.              ListAddObject('TEXT',ftMemo);
  4651.              ListAddObject('DATE',ftDate);
  4652.              ListAddObject('BOOL',ftBoolean);
  4653.              ListAddObject('BLOB',ftBlob);
  4654.         End;
  4655.         Native_Paradox:
  4656.         Begin
  4657.              ListAddObject('CHAR',ftString);
  4658.              ListAddObject('DATE',ftDate);
  4659.              ListAddObject('SINT',ftSmallInt);
  4660.              ListAddObject('INT',ftInteger);
  4661.              ListAddObject('FLOAT',ftFloat);
  4662.              ListAddObject('MONEY',ftCurrency);
  4663.              ListAddObject('NUMBER',ftInteger);
  4664.              ListAddObject('BOOL',ftBoolean);
  4665.              ListAddObject('TEXT',ftMemo);
  4666.              ListAddObject('BLOB',ftBlob);
  4667.              ListAddObject('FMTTEXT',ftFmtMemo);
  4668.              ListAddObject('TIME',ftTime);
  4669.              ListAddObject('DATETIME',ftDateTime);
  4670.              ListAddObject('AUTOINC',ftAutoInc);
  4671.              ListAddObject('BCD',ftBCD);
  4672.              ListAddObject('BYTES',ftBytes);
  4673.         End;
  4674.         Else
  4675.         Begin
  4676.              If FDataTypes<>Nil Then
  4677.              Begin
  4678.                   List.Assign(FDataTypes);
  4679.                   exit;
  4680.              End;
  4681.  
  4682.              If @FDBProcs.SQLGetTypeInfo=Nil Then exit;
  4683.              If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  4684.              Begin
  4685.                   OldActive:=FActive;
  4686.                   OldOpen:=FOpened;
  4687.                   If Not FOpened Then
  4688.                   Begin
  4689.                        FActive:=True;
  4690.                        DoOpen;
  4691.                        If Not FOpened Then Active:=False;
  4692.                   End;
  4693.  
  4694.                   If FOpened Then
  4695.                   Begin
  4696.                        GetType(SQL_BIGINT);
  4697.                        GetType(SQL_BINARY);
  4698.                        GetType(SQL_BIT);
  4699.                        GetType(SQL_CHAR);
  4700.                        GetType(SQL_DATE);
  4701.                        GetType(SQL_DECIMAL);
  4702.                        GetType(SQL_DOUBLE);
  4703.                        GetType(SQL_FLOAT);
  4704.                        GetType(SQL_INTEGER);
  4705.                        GetType(SQL_LONGVARBINARY);
  4706.                        GetType(SQL_LONGVARCHAR);
  4707.                        GetType(SQL_NUMERIC);
  4708.                        GetType(SQL_REAL);
  4709.                        GetType(SQL_SMALLINT);
  4710.                        GetType(SQL_TIME);
  4711.                        GetType(SQL_TIMESTAMP);
  4712.                        GetType(SQL_TINYINT);
  4713.                        GetType(SQL_VARBINARY);
  4714.                        GetType(SQL_VARCHAR);
  4715.                   End;
  4716.  
  4717.                   If Not OldOpen Then DoClose;
  4718.                   FActive:=OldActive;
  4719.  
  4720.                   If FDataTypes=Nil Then If List.Count>0 Then
  4721.                   Begin
  4722.                       FDataTypes.Create;
  4723.                       FDataTypes.Assign(List);
  4724.                   End;
  4725.              End;
  4726.         End;
  4727.      End;
  4728. End;
  4729.  
  4730.  
  4731. Procedure TTable.GetForeignKeys(List:TStrings);
  4732. Begin
  4733.      GetKeys(List,False);
  4734. End;
  4735.  
  4736.  
  4737. Procedure TTable.GetTableNames(List:TStrings);
  4738. Begin
  4739.      GetNames(List,'TABLE');
  4740. End;
  4741.  
  4742.  
  4743. Procedure TTable.SetTableLock(LockType:TLockType;Lock:Boolean);
  4744. Var C:cstring;
  4745.     ahstmt:SQLHSTMT;
  4746.     S:String;
  4747. Begin
  4748.      If Lock Then
  4749.      Begin
  4750.           C:='LOCK TABLE '+TableName+' IN ';
  4751.           If LockType=ltReadLock Then C:=C+'EXCLUSIVE'
  4752.           Else C:=C+'SHARE';
  4753.           C:=C+' MODE';
  4754.      End
  4755.      Else C:='ROLLBACK';
  4756.  
  4757.      EnterSQLProcessing;
  4758.      FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  4759.  
  4760.      If FDBProcs.SQLExecDirect(ahstmt,C,SQL_NTS)<>SQL_SUCCESS Then
  4761.      Begin
  4762.           S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  4763.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4764.           SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S);
  4765.      End;
  4766.  
  4767.      FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  4768.      LeaveSQLProcessing;
  4769. End;
  4770.  
  4771. Procedure TTable.LockTable(LockType:TLockType);
  4772. Begin
  4773.      SetTableLock(LockType,True);
  4774. End;
  4775.  
  4776. Procedure TTable.UnlockTable(LockType:TLockType);
  4777. Begin
  4778.      SetTableLock(LockType,False);
  4779. End;
  4780.  
  4781.  
  4782. Procedure TTable.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  4783. Var  S:String;
  4784. Begin
  4785.      If ResName = rnDBTable Then
  4786.      Begin
  4787.           Move(Data,S,DataLen);
  4788.           TableName:=S;
  4789.      End
  4790.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  4791. End;
  4792.  
  4793.  
  4794. Function TTable.WriteSCUResource(Stream:TResourceStream):Boolean;
  4795. Var  S:String;
  4796. Begin
  4797.      Result := False;
  4798.      If Inherited WriteSCUResource(Stream) Then
  4799.      Begin
  4800.           S:=TableName;
  4801.           Result:=Stream.NewResourceEntry(rnDBTable,S,Length(S)+1);
  4802.      End;
  4803. End;
  4804.  
  4805.  
  4806. Function TTable.GetTableName:String;
  4807. Begin
  4808.      Result:=FTableName^;
  4809. End;
  4810.  
  4811.  
  4812. Procedure TTable.SetupComponent;
  4813. Begin
  4814.      AssignStr(FTableName,'');
  4815.      AssignStr(FMasterFields,'');
  4816.  
  4817.      Inherited SetupComponent;
  4818.  
  4819.      Name:='Table';
  4820. End;
  4821.  
  4822.  
  4823. Procedure TTable.SetActive(NewValue:Boolean);
  4824. Begin
  4825.      If FActive = NewValue Then exit;
  4826.  
  4827.      Inherited SetActive(NewValue);
  4828.  
  4829.      If FActive Then
  4830.      Begin
  4831.           RefreshTable;
  4832.           FActive := FOpened;
  4833.      End
  4834.      Else DoClose;
  4835. End;
  4836.  
  4837.  
  4838. Procedure TTable.RefreshTable;
  4839. Begin
  4840.      If ((csReading In ComponentState) Or (FDataSetLocked)) Then
  4841.      Begin
  4842.           FRefreshOnLoad := FActive;
  4843.           Exit;
  4844.      End;
  4845.      DoOpen;
  4846.      If Not FOpened Then Exit;
  4847.      If TableName <> '' Then QueryTable;
  4848. End;
  4849.  
  4850.  
  4851. Procedure TTable.SetTableName(NewValue:String);
  4852. Begin
  4853.      If GetTableName=NewValue Then Exit;
  4854.  
  4855.      If FIndexDefs<>Nil Then FIndexDefs.Clear;
  4856.      AssignStr(FTableName,NewValue);
  4857.  
  4858.      FSelect.Clear;
  4859.      NewValue:='SELECT * FROM '+ NewValue;
  4860.      FSelect.Add(NewValue);
  4861.  
  4862.      If FActive Then
  4863.      Begin
  4864.           RefreshTable;
  4865.  
  4866.           DataChange(deTableNameChanged);
  4867.      End;
  4868. End;
  4869.  
  4870. Function TTable.GetPassword:String;
  4871. Begin
  4872.      Result:=FDBProcs.pwd;
  4873. End;
  4874.  
  4875. Function TTable.GetUserId:String;
  4876. Begin
  4877.      Result:=FDBProcs.uid;
  4878. End;
  4879.  
  4880. Procedure TTable.SetPassword(NewValue:String);
  4881. Begin
  4882.      If FOpened Then
  4883.      Begin
  4884.           ErrorBox(LoadNLSStr(SCannotPerformDBAction));
  4885.           Exit;
  4886.      End;
  4887.      FDBProcs.pwd:=NewValue;
  4888. End;
  4889.  
  4890. Procedure TTable.SetUserId(NewValue:String);
  4891. Begin
  4892.      If FOpened Then
  4893.      Begin
  4894.           ErrorBox(LoadNLSStr(SCannotPerformDBAction));
  4895.           Exit;
  4896.      End;
  4897.      FDBProcs.uid:=NewValue;
  4898. End;
  4899.  
  4900. Destructor TTable.Destroy;
  4901. Begin
  4902.      DoClose;
  4903.      FreeDBProcs(FDBProcs);
  4904.      AssignStr(FTableName,'');
  4905.      If FServants<>Nil Then
  4906.      Begin
  4907.           NotifyServants(Self);
  4908.           FServants.Destroy;
  4909.      End;
  4910.      FServants:=Nil;
  4911.      If FDataTypes<>Nil Then
  4912.      Begin
  4913.          FDataTypes.Destroy;
  4914.          FDataTypes:=Nil;
  4915.      End;
  4916.      If FIndexDefs<>Nil Then
  4917.      Begin
  4918.          FIndexDefs.Destroy;
  4919.          FIndexDefs:=Nil;
  4920.      End;
  4921.      If FIndexFieldMap<>Nil Then
  4922.      Begin
  4923.         FIndexFieldMap.Destroy;
  4924.         FIndexFieldMap:=Nil;
  4925.      End;
  4926.      If FMasterSource<>Nil Then
  4927.       If FMasterSource.DataSet Is TTable Then
  4928.         TTable(FMasterSource.DataSet).ConnectServant(Self,False);
  4929.      AssignStr(FMasterFields,'');
  4930.  
  4931.      Inherited Destroy;
  4932. End;
  4933.  
  4934. Procedure TTable.Loaded;
  4935. Begin
  4936.      If FTempMasterSource<>Nil Then
  4937.        If FTempMasterSource.DataSet Is TTable Then
  4938.          If FMasterSource=Nil Then MasterSource:=FTempMasterSource;
  4939.      Inherited Loaded;
  4940. End;
  4941.  
  4942. {$HINTS OFF}
  4943. Procedure TTable.UpdateLinkList(Const PropertyName:String;LinkList:TList);
  4944. Var T:LongInt;
  4945.     DataSource:TDataSource;
  4946. Begin
  4947.      For T:=LinkList.Count-1 DownTo 0 Do
  4948.      Begin
  4949.           DataSource:=TDataSource(LinkList[T]);
  4950.           If DataSource Is TDataSource Then
  4951.           Begin
  4952.                If DataSource.DataSet Is TTable Then
  4953.                Begin
  4954.                     //no recursive elements !!
  4955.                     If TTable(DataSource.DataSet)=Self Then LinkList.Remove(DataSource);
  4956.                End
  4957.                Else
  4958.                Begin
  4959.                     //no DataSources that are Not linked To tables !
  4960.                     LinkList.Remove(DataSource);
  4961.                End;
  4962.           End;
  4963.      End;
  4964. End;
  4965. {$HINTS ON}
  4966.  
  4967. Procedure TTable.SetMasterSource(NewValue:TDataSource);
  4968. Var OldLocked:Boolean;
  4969.     IsLoaded:Boolean;
  4970. Begin
  4971.      If NewValue=FMasterSource Then Exit;
  4972.      If NewValue<>Nil Then
  4973.      Begin
  4974.          If Not (NewValue.DataSet Is TTable) Then
  4975.          Begin
  4976.              IsLoaded:=((ComponentState*[csReading]=[])And(Not FDataSetLocked));
  4977.              If ((NewValue.DataSet=Nil)And(Not IsLoaded)) Then FTempMasterSource:=NewValue
  4978.              Else If ComponentState*[csDesigning]<>[] Then ErrorBox(LoadNLSStr(SDataSourceLinkError));
  4979.              Exit;
  4980.          End;
  4981.          If TTable(NewValue.DataSet)=Self Then
  4982.          Begin
  4983.              If ComponentState*[csDesigning]<>[] Then ErrorBox('Illegal recursive DataSource link');
  4984.              Exit;
  4985.          End;
  4986.          If ((FServants<>Nil)And(FServants.IndexOf(NewValue.DataSet)>=0)) Then
  4987.          Begin
  4988.              If ComponentState*[csDesigning]<>[] Then ErrorBox('Illegal circular DataSource link');
  4989.              Exit;
  4990.          End;
  4991.  
  4992.      End;
  4993.  
  4994.      //prevent call Of RefreshTable In ConnectServant
  4995.      OldLocked:=FDataSetLocked;
  4996.      FDataSetLocked:=True;
  4997.      If FMasterSource<>Nil Then
  4998.       If FMasterSource.DataSet Is TTable Then
  4999.         TTable(FMasterSource.DataSet).ConnectServant(Self,False);
  5000.      FMasterSource:=NewValue;
  5001.      FDataSetLocked:=OldLocked;
  5002.      If FMasterSource<>Nil Then
  5003.      Begin
  5004.          If FMasterSource.DataSet Is TTable Then
  5005.            TTable(FMasterSource.DataSet).ConnectServant(Self,True)
  5006.          Else If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then RefreshTable;
  5007.      End
  5008.      Else If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then RefreshTable;
  5009. End;
  5010.  
  5011. Function TTable.GetMasterFields:String;
  5012. Begin
  5013.      Result:=FMasterFields^;
  5014. End;
  5015.  
  5016. Procedure TTable.SetMasterFields(Const NewValue:String);
  5017. Begin
  5018.      If GetMasterFields=NewValue Then exit;
  5019.  
  5020.      AssignStr(FMasterFields,NewValue);
  5021.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then RefreshTable;
  5022. End;
  5023.  
  5024. Procedure TTable.ConnectServant(Servant:TTable;Connect:Boolean);
  5025. Begin
  5026.      If Connect Then
  5027.      Begin
  5028.           If FServants=Nil Then FServants.Create;
  5029.           FServants.Add(Servant);
  5030.      End
  5031.      Else If FServants<>Nil Then
  5032.      Begin
  5033.           If FServants.IndexOf(Servant)>=0 Then FServants.Remove(Servant);
  5034.      End;
  5035.  
  5036.      If ((Servant.ComponentState*[csReading]=[])And(Not Servant.FDataSetLocked)) Then
  5037.        Servant.RefreshTable;
  5038. End;
  5039.  
  5040. Procedure TTable.DataChange(event:TDataChange);
  5041. Var T:LongInt;
  5042.     Servant:TTable;
  5043. Begin
  5044.      If FServants<>Nil Then For T:=0 To FServants.Count-1 Do
  5045.      Begin
  5046.           Servant:=FServants[T];
  5047.           If ((Servant.ComponentState*[csReading]=[])And(Not Servant.FDataSetLocked)) Then
  5048.              Servant.RefreshTable;
  5049.      End;
  5050.  
  5051.      Inherited DataChange(event);
  5052. End;
  5053.  
  5054.  
  5055. Function TTable.GetResultColRow(Col,Row:LongInt):TField;
  5056. Var FieldDef:TFieldDef;
  5057.     I,t:LongInt;
  5058.     field:TField;
  5059.     rc:SQLRETURN;
  5060.     OutLen:LongInt;
  5061.     Temp:Pointer;
  5062.     NewLen:LongInt;
  5063.     MapType:LongInt;
  5064.     S:String;
  5065.     ActRows:LongWord;
  5066.     RowStatus:Word;
  5067.     ExtFetchOk:Boolean;
  5068.     e:Extended;
  5069.     Header:TGraphicHeader;
  5070. Label again,err;
  5071. Begin
  5072.      Result := Nil;
  5073.      If Not FOpened Then Exit;
  5074.  
  5075.      Result := Inherited GetResultColRow(Col,Row);
  5076.      If Result <> Nil Then exit;
  5077.  
  5078.      If FDBProcs.ahstmt=0 Then Exit;       {no previous Select Command Or no more Rows}
  5079.  
  5080.      /* Store Result Row(S)  */
  5081. again:
  5082.      //Try if we are able to retrieve cursored rows !
  5083.      If Self Is TStoredProc Then //due to "Function sequence error"
  5084.      Begin
  5085.           rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  5086.           ExtFetchOk:=False;
  5087.      End
  5088.      Else
  5089.      Begin
  5090.           rc:=FDBProcs.SQLExtendedFetch(FDBProcs.ahstmt,SQL_FETCH_ABSOLUTE,
  5091.                                         Row+1,ActRows,RowStatus);
  5092.           ExtFetchOk:=rc<>SQL_ERROR;
  5093.           If not ExtFetchOk Then rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt); //Driver not capable (DB2 !)
  5094.      End;
  5095.  
  5096.      FieldDef:=FFieldDefs[0];
  5097.  
  5098.      If ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Then
  5099.      Begin
  5100.           For I:=0 To FFieldDefs.Count-1 Do
  5101.           Begin
  5102.                FieldDef:=FFieldDefs[I];
  5103.                {Create Row}
  5104.                Field := FieldDef.CreateField(Nil);
  5105.                If ExtFetchOk Then Field.FRow:=Row+1
  5106.                Else Field.FRow:=FieldDef.Fields.Count;
  5107.                Field.FCol:=I;
  5108.  
  5109.                Case FieldDef.DataType Of
  5110.                   ftBytes,ftVarBytes,ftBlob,ftMemo,ftGraphic,
  5111.                   ftFmtMemo,ftTypedBinary:MapType:=SQL_C_BINARY;
  5112.                   ftFloat:
  5113.                   Begin
  5114.                        Case FieldDef.Size Of
  5115.                          4:MapType:=SQL_C_FLOAT;
  5116.                          Else MapType:=SQL_C_DOUBLE;
  5117.                        End; //case
  5118.                   End;
  5119.                   Else MapType:=SQL_C_DEFAULT;
  5120.                End;
  5121.  
  5122.                rc:=FDBProcs.SQLGetData(FDBProcs.ahstmt,I+1,MapType,field.FValue^,
  5123.                                        FieldDef.Size,OutLen);
  5124.                If rc<>SQL_ERROR Then
  5125.                Begin
  5126.                     If ((rc=SQL_SUCCESS_WITH_INFO)And(OutLen>field.FValueLen)And
  5127.                         (MapType=SQL_C_BINARY)) Then
  5128.                     Begin
  5129.                          NewLen:=OutLen-field.FValueLen;
  5130.                          GetMem(Temp,OutLen);
  5131.                          Move(Field.FValue^,Temp^,Field.FValueLen);
  5132.                          FreeMem(Field.FValue,Field.FValueLen);
  5133.                          Field.FValue:=Temp;
  5134.                          Inc(Temp,field.FValueLen);
  5135.                          Field.FValueLen:=OutLen;
  5136.                          rc:=FDBProcs.SQLGetData(FDBProcs.ahstmt,I+1,MapType,Temp^,
  5137.                                                  NewLen,OutLen);
  5138.                          If rc=SQL_ERROR Then
  5139.                          Begin
  5140.                               Field.Destroy;
  5141.                               Goto err;
  5142.                          End;
  5143.                          OutLen:=Field.FValueLen+1;
  5144.                     End;
  5145.  
  5146.                     If OutLen=SQL_NULL_DATA Then
  5147.                     Begin
  5148.                          Field.FreeMemory;  //TOM TEST
  5149.                     End
  5150.                     Else
  5151.                     Begin
  5152.                          If OutLen<=field.FValueLen Then
  5153.                          Begin
  5154.                               GetMem(Temp,OutLen);
  5155.                               Move(Field.FValue^,Temp^,OutLen);
  5156.                               FreeMem(Field.FValue,Field.FValueLen);
  5157.                               Field.FValue:=Temp;
  5158.                               Field.FValueLen:=OutLen;
  5159.                          End;
  5160.                     End;
  5161.  
  5162.                     If ExtFetchOk Then
  5163.                     Begin
  5164.                        If Row<=FieldDef.Fields.Count-1 Then
  5165.                        Begin
  5166.                            FieldDef.Fields[Row]:=Field;
  5167.                        End
  5168.                        Else
  5169.                        Begin
  5170.                            For t:=FieldDef.Fields.Count+1 To Row Do
  5171.                              FieldDef.Fields.Add(Nil);
  5172.                            FieldDef.Fields.Add(Field);
  5173.                        End;
  5174.                     End
  5175.                     Else FieldDef.Fields.Add(Field);
  5176.                End
  5177.                Else
  5178.                Begin
  5179.                     Field.Destroy;
  5180.                     Goto err;
  5181.                End;
  5182.  
  5183.                If Field Is TBlobField Then // check graphic header
  5184.                Begin
  5185.                     If Field.FValueLen >= SizeOf(TGraphicHeader) Then
  5186.                     Begin
  5187.                          move(Field.FValue^, Header, SizeOf(TGraphicHeader));
  5188.                          If (Header.Count = 1) And (Header.HType = $0100) And
  5189.                             (Header.Size = Field.FValueLen - SizeOf(TGraphicHeader)) Then
  5190.                          Begin
  5191.                               GetMem(Temp, Header.Size);
  5192.                               inc(Field.FValue, SizeOf(TGraphicHeader));
  5193.                               Move(Field.FValue^,Temp^, Header.Size);
  5194.                               dec(Field.FValue, SizeOf(TGraphicHeader));
  5195.                               FreeMem(Field.FValue, Field.FValueLen);
  5196.                               Field.FValue := Temp;
  5197.                               Field.FValueLen := Header.Size;
  5198.                               //Field.FBlobType := ftGraphic;
  5199.                          End;
  5200.                     End;
  5201.                End;
  5202.           End;
  5203.  
  5204.           FieldDef:=FFieldDefs[Col];
  5205.  
  5206.           If ((ExtFetchOk)Or(Row=FieldDef.Fields.Count-1)) Then
  5207.           Begin
  5208.                {result found}
  5209.                Result:=FieldDef.Fields.Items[Row];
  5210.                exit;
  5211.           End;
  5212.  
  5213.           Goto again;  {fetch Next Row}
  5214.      End
  5215.      Else
  5216.      Begin
  5217.           {no more Rows}
  5218.           If rc=SQL_ERROR Then
  5219.           Begin
  5220. err:
  5221.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  5222.                CloseStmt;
  5223.                SQLError('Error fetching result row '+FieldDef.Name+#13#10+S);
  5224.           End;
  5225.  
  5226.           CloseStmt;
  5227.      End;
  5228. End;
  5229.  
  5230.  
  5231. Procedure TTable.GetKeys(List:TStrings;Primary:Boolean);
  5232. Var ahstmt:SQLHSTMT;
  5233.     cols:SQLSMALLINT;
  5234.     C:Array[0..8] Of cstring;
  5235.     cc:cstring;
  5236.     S,S1:String;
  5237.     I:LongInt;
  5238.     OutLen:Array[0..8] Of SQLINTEGER;
  5239.     rc:SQLRETURN;
  5240.     Offset,Offset1:LongInt;
  5241. Begin
  5242.      If Primary Then
  5243.      Begin
  5244.           Offset:=0;
  5245.           Offset1:=0;
  5246.      End
  5247.      Else
  5248.      Begin
  5249.           Offset:=4;
  5250.           Offset1:=-4;
  5251.      End;
  5252.  
  5253.      EnterSQLProcessing;
  5254.      FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5255.  
  5256.      cc:=TableName;
  5257.      Try //Some DB2 Servers return a GPF here ...
  5258.        rc:=SQL_ERROR;
  5259.        If TableName<>'' Then
  5260.        Begin
  5261.             If Primary Then
  5262.               rc:=FDBProcs.SQLPrimaryKeys(ahstmt,Nil,0,Nil,0,cc,SQL_NTS)
  5263.             Else If @FDBProcs.SQLForeignKeys<>Nil Then
  5264.               rc:=FDBProcs.SQLForeignKeys(ahstmt,Nil,0,Nil,0,Nil,0,Nil,0,Nil,0,cc,SQL_NTS);
  5265.        End
  5266.        Else
  5267.        Begin
  5268.             If Primary Then
  5269.               rc:=FDBProcs.SQLPrimaryKeys(ahstmt,Nil,0,Nil,0,Nil,0)
  5270.             Else If @FDBProcs.SQLForeignKeys<>Nil Then
  5271.               rc:=FDBProcs.SQLForeignKeys(ahstmt,Nil,0,Nil,0,Nil,0,Nil,0,Nil,0,Nil,0);
  5272.        End;
  5273.  
  5274.        If rc=SQL_SUCCESS Then
  5275.        Begin
  5276.             FDBProcs.SQLNumResultCols(ahstmt,cols);
  5277.             If cols>8 Then cols:=8;
  5278.             For I := 0 To cols-1 Do
  5279.                FDBProcs.SQLBindCol(ahstmt, I + 1, SQL_C_CHAR, C[I], 255, OutLen[I]);
  5280.             rc:=FDBProcs.SQLFetch(ahstmt);
  5281.             While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  5282.             Begin
  5283.                  If OutLen[3+Offset]<>SQL_NULL_DATA Then
  5284.                  Begin
  5285.                       Move(C[3+Offset],S[1],OutLen[3+Offset]);
  5286.                       S[0]:=Chr(OutLen[3+Offset]);
  5287.                       If S[Length(S)]=#0 Then
  5288.                         If length(S)>0 Then dec(S[0]);
  5289.                       If ((TableName='')Or(Not Primary)) Then
  5290.                       Begin
  5291.                            If OutLen[2+Offset+Offset1]<>SQL_NULL_DATA Then
  5292.                            Begin
  5293.                                Move(C[2+Offset+Offset1],S1[1],OutLen[2+Offset+Offset1]);
  5294.                                S1[0]:=Chr(OutLen[2+Offset+Offset1]);
  5295.                                If S1[Length(S1)]=#0 Then
  5296.                                  If length(S1)>0 Then dec(S1[0]);
  5297.                                If not Primary Then
  5298.                                Begin
  5299.                                     S:=S+'>'+S1;
  5300.                                     If OutLen[2+Offset+Offset1+1]<>SQL_NULL_DATA Then
  5301.                                     Begin
  5302.                                         Move(C[2+Offset+Offset1+1],S1[1],OutLen[2+Offset+Offset1+1]);
  5303.                                         S1[0]:=Chr(OutLen[2+Offset+Offset1+1]);
  5304.                                         If S1[Length(S1)]=#0 Then
  5305.                                          If length(S1)>0 Then dec(S1[0]);
  5306.                                         S:=S+'.'+S1;
  5307.                                     End;
  5308.                                End
  5309.                                Else S:=S1+'.'+S;
  5310.                            End;
  5311.                       End;
  5312.                       List.Add(S);
  5313.                  End;
  5314.                  rc:=FDBProcs.SQLFetch(ahstmt);
  5315.             End;
  5316.        End;
  5317.      Except
  5318.        List.Clear;
  5319.      End;
  5320.  
  5321.      FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5322.      LeaveSQLProcessing;
  5323. End;
  5324.  
  5325.  
  5326. Procedure TTable.DoOpen;
  5327. Var rc:SQLRETURN;
  5328.     s:String;
  5329.     fmode:Longword;
  5330. Begin
  5331.      If Not FActive Then Exit;
  5332.  
  5333.      If Not FillDBProcs(FDBProcs) Then
  5334.      Begin
  5335.           LeaveSQLProcessing;
  5336.           ErrorBox(LoadNLSStr(SErrLoadingDB));
  5337.           Active:=False;
  5338.           Exit; {Error}
  5339.      End;
  5340.  
  5341.      If Not FOpened Then
  5342.      Begin
  5343.           EnterSQLProcessing;
  5344.  
  5345.           Try
  5346.              If FBeforeOpen<>Nil Then FBeforeOpen(Self);
  5347.  
  5348.              FDBProcs.ahstmt:=0;
  5349.              FDBProcs.ahenv:=0;
  5350.              If AllocateDBEnvironment(FDBProcs)<>SQL_SUCCESS Then
  5351.              Begin
  5352.                   LeaveSQLProcessing;
  5353.                   ErrorBox(LoadNLSStr(SErrAllocDBEnv)+'.'+
  5354.                            SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  5355.                   Active:=False;
  5356.                   Exit;
  5357.              End;
  5358.  
  5359.              {Connect To Server}
  5360.              FDBProcs.ahdbc:=0;
  5361.              If FDBProcs.SQLAllocConnect(FDBProcs.ahenv,FDBProcs.ahdbc)<>SQL_SUCCESS Then
  5362.              Begin
  5363.                   LeaveSQLProcessing;
  5364.                   ErrorBox(LoadNLSStr(SErrAllocDBConnect)+'.'+
  5365.                             SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  5366.                   DoClose;
  5367.                   Exit;
  5368.              End;
  5369.  
  5370.              {Set autocommit OFF}
  5371.              If FDBProcs.SQLSetConnectOption(FDBProcs.ahdbc,SQL_AUTOCOMMIT,SQL_AUTOCOMMIT_OFF)<>SQL_SUCCESS Then
  5372.              Begin
  5373.                   LeaveSQLProcessing;
  5374.                   ErrorBox(LoadNLSStr(SErrSettingDBOpts)+'.'+
  5375.                             SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  5376.                   DoClose;
  5377.                   Exit;
  5378.              End;
  5379.  
  5380.              {Connect}
  5381.              Try
  5382.                 If FDBProcs.uid='' Then
  5383.                 Begin
  5384.                      If FDBProcs.pwd='' Then
  5385.                        rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  5386.                                                Nil,0,Nil,0)
  5387.                      Else
  5388.                        rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  5389.                                                Nil,0,FDBProcs.pwd,SQL_NTS);
  5390.                 End
  5391.                 Else If FDBProcs.pwd='' Then
  5392.                 Begin
  5393.                      rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  5394.                                              FDBProcs.uid,SQL_NTS,Nil,0);
  5395.                 End
  5396.                 Else rc:= FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  5397.                                               FDBProcs.uid,SQL_NTS,FDBProcs.pwd,SQL_NTS);
  5398.                 If rc<>SQL_SUCCESS Then
  5399.                 Begin
  5400.                      S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0);
  5401.                      DoClose;
  5402.                      SQLError(LoadNLSStr(SErrorDBConnecting)+' "'+DataBase+'".'+#13#10+S);
  5403.                 End;
  5404.              Except
  5405.                 ON E:ESQLError Do
  5406.                 Begin
  5407.                      LeaveSQLProcessing;
  5408.                      ErrorBox(E.Message);
  5409.                      Exit;
  5410.                 End;
  5411.                 Else Raise;
  5412.              End;
  5413.  
  5414.              FOpened:=True;
  5415.  
  5416.              LeaveSQLProcessing;
  5417.              If FAfterOpen<>Nil Then AfterOpen(Self);
  5418.           Except
  5419.             LeaveSQLProcessing;
  5420.             Raise;
  5421.           End;
  5422.      End;
  5423. End;
  5424.  
  5425.  
  5426. Procedure TTable.DoClose;
  5427. Begin
  5428.      Try
  5429.         If FBeforeClose<>Nil Then FBeforeClose(Self);
  5430.  
  5431.         If FOpened Then
  5432.         Begin
  5433.              CloseStmt;
  5434.              Post;  //Commit All transactions
  5435.         End;
  5436.  
  5437.         FActive:=False;
  5438.         FDataSetLocked:=True;
  5439.         FFieldDefs.Clear;
  5440.         FDataSetLocked:=False;
  5441.  
  5442.         If FDBProcs.ahdbc <> 0 Then
  5443.         Begin
  5444.              If FOpened Then
  5445.                If FDBProcs.SQLDisconnect(FDBProcs.ahdbc) <> SQL_SUCCESS Then
  5446.                  ErrorBox('Disconnect error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  5447.              If FDBProcs.SQLFreeConnect(FDBProcs.ahdbc) <> SQL_SUCCESS Then
  5448.                ErrorBox('FreeConnect error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  5449.              FDBProcs.ahdbc := 0;
  5450.         End;
  5451.  
  5452.         If FDBProcs.ahenv <> 0 Then
  5453.         Begin
  5454.              If FDBProcs.SQLFreeEnv(FDBProcs.ahenv) <> SQL_SUCCESS Then
  5455.                ErrorBox('FreeEnv error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  5456.              FDBProcs.ahenv := 0;
  5457.         End;
  5458.  
  5459.         Inherited DoClose;
  5460.  
  5461.         DataChange(deDataBaseChanged);
  5462.  
  5463.         If FAfterClose<>Nil Then FAfterClose(Self);
  5464.      Except
  5465.         Raise;
  5466.      End;
  5467. End;
  5468.  
  5469.  
  5470. Procedure TTable.GetStoredProcNames(List:TStrings);
  5471. Var
  5472.    ahstmt:SQLHSTMT;
  5473.    cols:SQLSMALLINT;
  5474.    I:LongInt;
  5475.    C:Array[0..4] Of cstring;
  5476.    OutLen:Array[0..4] Of SQLINTEGER;
  5477.    rc:SQLRETURN;
  5478.    S,S1:String;
  5479.    OldActive:Boolean;
  5480.    OldOpen:Boolean;
  5481. Begin
  5482.      Inherited GetStoredProcNames(List);
  5483.  
  5484.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  5485.      Begin
  5486.           OldActive:=FActive;
  5487.           OldOpen:=FOpened;
  5488.           If Designed Then
  5489.             If Not FOpened Then
  5490.             Begin
  5491.                  FActive:=True;
  5492.                  DoOpen;
  5493.                  If Not FOpened Then Active:=False;
  5494.             End;
  5495.  
  5496.           If FOpened Then
  5497.           Begin
  5498.                EnterSQLProcessing;
  5499.                FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5500.  
  5501.                If FDBProcs.SQLProcedures(ahstmt,Nil,0,Nil,0,Nil,0)=SQL_SUCCESS Then
  5502.                Begin
  5503.                     FDBProcs.SQLNumResultCols(ahstmt,cols);
  5504.                     If cols>3 Then cols:=3;
  5505.                     For I := 0 To cols-1 Do
  5506.                       FDBProcs.SQLBindCol(ahstmt, I + 1, SQL_C_CHAR, C[I], 255, OutLen[I]);
  5507.                     rc:=FDBProcs.SQLFetch(ahstmt);
  5508.                     While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  5509.                     Begin
  5510.                          If OutLen[2]<>SQL_NULL_DATA Then
  5511.                          Begin
  5512.                               Move(C[2],S[1],OutLen[2]);
  5513.                               S[0]:=Chr(OutLen[2]);
  5514.                               If S[length(S)]=#0 Then
  5515.                                If length(S)>0 Then dec(S[0]);
  5516.                               If OutLen[0]<>SQL_NULL_DATA Then
  5517.                               Begin
  5518.                                    Move(C[0],S1[1],OutLen[0]);
  5519.                                    S1[0]:=Chr(OutLen[0]);
  5520.                                    If S1[length(S1)]=#0 Then
  5521.                                     If length(S1)>0 Then dec(S1[0]);
  5522.                                    If S1<>'' Then S:=S1+'.'+S;
  5523.                               End;
  5524.                               List.Add(S);
  5525.                          End;
  5526.                          rc:=FDBProcs.SQLFetch(ahstmt);
  5527.                     End;
  5528.                End
  5529.                Else List.Clear;
  5530.  
  5531.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5532.                LeaveSQLProcessing;
  5533.           End;
  5534.  
  5535.           If Designed Then
  5536.           Begin
  5537.                If Not OldOpen Then DoClose;
  5538.                FActive:=OldActive;
  5539.           End;
  5540.      End;
  5541. End;
  5542.  
  5543.  
  5544. Procedure TTable.GetDataSources(List:TStrings);
  5545. Var
  5546.     AliasName,DriverName,Advanced,UID:String;
  5547.     t,Count:LongInt;
  5548. Begin
  5549.      List.Clear;
  5550.  
  5551.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  5552.      Begin
  5553.           Count:=GetDbAliasNamesCount;
  5554.           For t:=0 To Count-1 Do
  5555.           Begin
  5556.                GetDBAlias(t,AliasName,DriverName,Advanced,UID);
  5557.                List.Add(AliasName);
  5558.           End;
  5559.      End;
  5560. End;
  5561.  
  5562.  
  5563. Procedure TTable.DoDelete;
  5564. Var C,c1:cstring;
  5565.     ahstmt,ahstmt1:SQLHSTMT;
  5566.     S:String;
  5567.     resultCols:SQLSMALLINT;
  5568.     rc:SQLRETURN;
  5569.     T:LongInt;
  5570.     T1,RowId:LongInt;
  5571.     Res:SQLINTEGER;
  5572.     OracleRowId:CString;
  5573. Begin
  5574.      If ReadOnly Then SQLError('Cannot modify a readonly dataset!');
  5575.  
  5576.      If (Not IsTable) Then exit; //cannot update this result set...
  5577.  
  5578.      EnterSQLProcessing;
  5579.      FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5580.  
  5581.      Case FDBProcs.DBType Of
  5582.        Native_mSQL:    C:='SELECT _rowid,'+Fields[0].FieldName+' FROM '+TableName;
  5583.        Native_Oracle7: C:='SELECT ROWID,'+Fields[0].FieldName+' FROM '+TableName+' FOR UPDATE'
  5584.        Else            C:='SELECT * FROM '+TableName+' FOR UPDATE';
  5585.      End;
  5586.  
  5587.      If FDBProcs.SQLExecDirect(ahstmt,C,SQL_NTS)<>SQL_SUCCESS Then
  5588.      Begin
  5589.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5590.            FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5591.            SQLError('Error executing SELECT SQL statement: '+S);
  5592.      End;
  5593.  
  5594.      FDBProcs.SQLNumResultCols(ahstmt,resultCols);
  5595.      If resultCols=0 Then //Not A Select statement
  5596.      Begin
  5597.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5598.           LeaveSQLProcessing;
  5599.           Exit;
  5600.      End;
  5601.  
  5602.      If FDBProcs.DBType=Native_mSQL Then T1:=Fields[0].FRow-1
  5603.      Else T1:=Fields[0].FRow;
  5604.  
  5605.      For T:=0 To T1 Do
  5606.      Begin
  5607.           rc:=FDBProcs.SQLFetch(ahstmt);
  5608.           If ((rc=SQL_NO_DATA_FOUND)Or(rc=SQL_ERROR)) Then
  5609.           Begin
  5610.                 S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5611.                 FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5612.                 SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5613.           End;
  5614.      End;
  5615.  
  5616.      If FDBProcs.DBType=Native_mSQL Then
  5617.      Begin
  5618.           If FDBProcs.SQLGetData(ahstmt,1,SQL_INTEGER,RowId,4,Res)<>SQL_SUCCESS Then
  5619.           Begin
  5620.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5621.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5622.                SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5623.           End;
  5624.      End;
  5625.  
  5626.      If FDBProcs.DBType=Native_Oracle7 Then
  5627.      Begin
  5628.           If FDBProcs.SQLGetData(ahstmt,1,SQL_C_CHAR,OracleRowId,255,Res)<>SQL_SUCCESS Then
  5629.           Begin
  5630.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5631.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5632.                SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5633.           End;
  5634.      End;
  5635.  
  5636.      FillChar(c1,255,0);
  5637.      If FDBProcs.SQLGetCursorName(ahstmt,c1,255,resultCols)<>SQL_SUCCESS Then
  5638.      Begin
  5639.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5640.            FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5641.            SQLError('Error executing SQLGetCursorName statement: '+S);
  5642.      End;
  5643.  
  5644.      If FDBProcs.DBType=Native_Oracle7 Then ahstmt1:=ahstmt
  5645.      Else
  5646.      Begin
  5647.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5648.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt1);
  5649.      End;
  5650.      S:='DELETE FROM '+TableName;
  5651.      Case FDBProcs.DBType Of
  5652.        Native_mSQL:    S:=S+' WHERE _rowid='+tostr(RowId);
  5653.        Native_Oracle7: S:=S+' WHERE ROWID='+#39+OracleRowId+#39;
  5654.        Else            S:=S+' WHERE CURRENT OF '+c1;
  5655.      End;
  5656.      C:=S;
  5657.  
  5658.      If FDBProcs.SQLExecDirect(ahstmt1,C,SQL_NTS)<>SQL_SUCCESS Then
  5659.      Begin
  5660.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt1);
  5661.            FDBProcs.SQLFreeStmt(ahstmt1,SQL_DROP);
  5662.            SQLError('Error executing SQL DELETE statement: '+S);
  5663.      End;
  5664.  
  5665.      FDBProcs.SQLFreeStmt(ahstmt1,SQL_DROP);
  5666.      LeaveSQLProcessing;
  5667.  
  5668.      Inherited DoDelete;
  5669. End;
  5670.  
  5671.  
  5672. Procedure TTable.CommitInsert(Commit:Boolean);
  5673. Var ahstmt:SQLHSTMT;
  5674.     Ansi:AnsiString;
  5675.     S:String;
  5676.     T:LongInt;
  5677.     Field:TField;
  5678.     i:LongInt;
  5679. Begin
  5680.      Inherited CommitInsert(Commit);
  5681.  
  5682.      If ReadOnly Then SQLError('Cannot modify a readonly dataset!');
  5683.  
  5684.      If Commit Then
  5685.      Begin
  5686.           EnterSQLProcessing;
  5687.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5688.  
  5689.           Ansi:='INSERT INTO '+TableName+' (';
  5690.           For T:=0 To FieldCount-1 Do
  5691.           Begin
  5692.                Ansi:=Ansi+FieldNames[T];
  5693.                If T<>FieldCount-1 Then Ansi:=Ansi+',';
  5694.           End;
  5695.  
  5696.           Ansi:=Ansi+') VALUES(';
  5697.           For T:=0 To FieldCount-1 Do
  5698.           Begin
  5699.                Field:=Fields[T];
  5700.                If Field.DataType=ftMemo Then Ansi:=Ansi+#39+PChar(Field.FValue)^+#39
  5701.                Else
  5702.                Begin
  5703.                   S:=Field2String(field);
  5704.                   Ansi:=Ansi+S;
  5705.                End;
  5706.                If T<>FieldCount-1 Then Ansi:=Ansi+',';
  5707.           End;
  5708.           Ansi:=Ansi+')';
  5709.  
  5710.           //ErrorBox2(PChar(Ansi)^);
  5711.           If FDBProcs.SQLExecDirect(ahstmt,PChar(Ansi)^,SQL_NTS)<>SQL_SUCCESS Then
  5712.           Begin
  5713.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5714.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5715.                SQLError('Error executing INSERT SQL statement: '+S);
  5716.           End;
  5717.  
  5718.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5719.           LeaveSQLProcessing;
  5720.  
  5721.           FRowIsInserted:=False;
  5722.           QueryTable;
  5723.      End
  5724.      Else
  5725.      Begin
  5726.           RemoveCurrentFields;
  5727.  
  5728.           RowInserted := False;
  5729.      End;
  5730. End;
  5731.  
  5732.  
  5733. Function TTable.UpdateFieldSelect(Field:TField):Boolean;
  5734. Var ahstmt,ahstmt1:SQLHSTMT;
  5735.     resultCols:SQLSMALLINT;
  5736.     C,c1:cstring;
  5737.     rc:SQLRETURN;
  5738.     S:String;
  5739.     T,T1,RowId:LongInt;
  5740.     Res:SQLINTEGER;
  5741.     Ansi:AnsiString;
  5742.     OracleRowId:CString;
  5743. Begin
  5744.      Result:=False;
  5745.      If Not FOpened Then Exit;
  5746.      If ((field=Nil)Or(FSelect.Count=0)) Then Exit;
  5747.      If FRowIsInserted Then
  5748.      Begin
  5749.           Result:=True;
  5750.           Exit;
  5751.      End;
  5752.  
  5753.      If ReadOnly Then SQLError('Cannot modify a readonly dataset!');
  5754.      If (Not IsTable) Then exit; //cannot update this result set...
  5755.  
  5756.      EnterSQLProcessing;
  5757.      FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5758.  
  5759.      Case FDBProcs.DBType Of
  5760.        Native_mSQL:    C:='SELECT _rowid,'+Field.FieldName+' FROM '+TableName;
  5761.        Native_Oracle7: C:='SELECT ROWID,'+Field.FieldName+' FROM '+TableName+' FOR UPDATE';
  5762.        Else            C:='SELECT * FROM '+TableName+' FOR UPDATE';
  5763.      End;
  5764.  
  5765.      If FDBProcs.SQLExecDirect(ahstmt,C,SQL_NTS)<>SQL_SUCCESS Then
  5766.      Begin
  5767.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5768.            FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5769.            SQLError('Error executing SELECT SQL statement: '+S);
  5770.      End;
  5771.  
  5772.      FDBProcs.SQLNumResultCols(ahstmt,resultCols);
  5773.      If resultCols=0 Then //Not A Select statement
  5774.      Begin
  5775.           FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5776.           LeaveSQLProcessing;
  5777.           Exit;
  5778.      End;
  5779.  
  5780.      If FDBProcs.DBType=Native_mSQL Then T1:=Field.FRow-1
  5781.      Else T1:=Field.FRow;
  5782.  
  5783.      For T:=0 To T1 Do
  5784.      Begin
  5785.           rc:=FDBProcs.SQLFetch(ahstmt);
  5786.           If ((rc=SQL_NO_DATA_FOUND)Or(rc=SQL_ERROR)) Then
  5787.           Begin
  5788.                 S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5789.                 FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5790.                 SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5791.           End;
  5792.      End;
  5793.  
  5794.      If FDBProcs.DBType=Native_mSQL Then
  5795.      Begin
  5796.           If FDBProcs.SQLGetData(ahstmt,1,SQL_INTEGER,RowId,4,Res)<>SQL_SUCCESS Then
  5797.           Begin
  5798.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5799.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5800.                SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5801.           End;
  5802.      End;
  5803.  
  5804.      If FDBProcs.DBType=Native_Oracle7 Then
  5805.      Begin
  5806.           If FDBProcs.SQLGetData(ahstmt,1,SQL_C_CHAR,OracleRowId,255,Res)<>SQL_SUCCESS Then
  5807.           Begin
  5808.                S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5809.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5810.                SQLError(LoadNLSStr(SErrorFetchingSQLStatement)+': '+S);
  5811.           End;
  5812.      End;
  5813.  
  5814.      FillChar(c1,255,0);
  5815.      If FDBProcs.SQLGetCursorName(ahstmt,c1,255,resultCols)<>SQL_SUCCESS Then
  5816.      Begin
  5817.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5818.            FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5819.            SQLError('Error executing SQLGetCursorName statement: '+S);
  5820.      End;
  5821.  
  5822.      If FDBProcs.DBType=Native_Oracle7 Then ahstmt1:=ahstmt
  5823.      Else
  5824.      Begin
  5825.          FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5826.          FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt1);
  5827.      End;
  5828.  
  5829.      Ansi:='UPDATE '+TableName+' SET '+field.FieldName+'=';
  5830.      If Field.DataType=ftMemo Then Ansi:=Ansi+#39+PChar(Field.FValue)^+#39
  5831.      Else Ansi:=Ansi+Field2String(field);
  5832.  
  5833.      Case FDBProcs.DBType Of
  5834.        Native_mSQL:    Ansi:=Ansi+' WHERE _rowid='+tostr(RowId);
  5835.        Native_Oracle7: Ansi:=Ansi+' WHERE ROWID='+#39+OracleRowId+#39;
  5836.        Else            Ansi:=Ansi+' WHERE CURRENT OF '+c1;
  5837.      End;
  5838.  
  5839.      If FDBProcs.SQLExecDirect(ahstmt1,PChar(Ansi)^,SQL_NTS)<>SQL_SUCCESS Then
  5840.      Begin
  5841.            S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt1);
  5842.            FDBProcs.SQLFreeStmt(ahstmt1,SQL_DROP);
  5843.            SQLError('Error executing SQL UPDATE statement: '+S);
  5844.      End;
  5845.  
  5846.      FDBProcs.SQLFreeStmt(ahstmt1,SQL_DROP);
  5847.      LeaveSQLProcessing;
  5848.      Result:=True;
  5849. End;
  5850.  
  5851.  
  5852. Procedure TTable.DoCancel;
  5853. Begin
  5854.      FDBProcs.SQLTransact(FDBProcs.ahenv,FDBProcs.ahdbc,SQL_ROLLBACK);
  5855. End;
  5856.  
  5857.  
  5858. Procedure TTable.DoPost;
  5859. Begin
  5860.      FDBProcs.SQLTransact(FDBProcs.ahenv,FDBProcs.ahdbc,SQL_COMMIT);
  5861. End;
  5862.  
  5863.  
  5864. Procedure TTable.CloseStmt;
  5865. Var I:LongInt;
  5866. Begin
  5867.      If Not FOpened Then Exit;
  5868.  
  5869.      {Free statement Handle}
  5870.      If FDBProcs.ahstmt<>0 Then
  5871.      Begin
  5872.           FDBProcs.SQLFreeStmt(FDBProcs.ahstmt,SQL_DROP);
  5873.           FDBProcs.ahstmt:=0;
  5874.      End;
  5875. End;
  5876.  
  5877.  
  5878. Procedure TTable.UpdateIndexDefs;
  5879. Var
  5880.    ahstmt:SQLHSTMT;
  5881.    cols:SQLSMALLINT;
  5882.    I:LongInt;
  5883.    C:Array[0..9] Of cstring;
  5884.    OutLen:Array[0..9] Of SQLINTEGER;
  5885.    rc:SQLRETURN;
  5886.    S,S1,Fields:String;
  5887.    OldActive:Boolean;
  5888.    OldOpen:Boolean;
  5889.    IndexDef:TIndexDef;
  5890. Begin
  5891.      If FIndexDefs<>Nil Then FIndexDefs.Clear
  5892.      Else FIndexDefs.Create(Self);
  5893.      If FIndexFieldMap<>Nil Then FIndexFieldMap.Clear;
  5894.  
  5895.      If (Not IsTable) Then SQLError('Illegal operation');
  5896.  
  5897.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  5898.      Begin
  5899.           OldActive:=FActive;
  5900.           OldOpen:=FOpened;
  5901.           If Not FOpened Then
  5902.           Begin
  5903.                FActive:=True;
  5904.                DoOpen;
  5905.                If Not FOpened Then Active:=False;
  5906.           End;
  5907.  
  5908.           If FOpened Then
  5909.             If @FDBProcs.SQLStatistics<>Nil Then
  5910.           Begin
  5911.                EnterSQLProcessing;
  5912.                FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  5913.  
  5914.                If FDBProcs.SQLStatistics(ahstmt,Nil,0,Nil,0,TableName,SQL_NTS,SQL_INDEX_ALL,SQL_ENSURE)=SQL_SUCCESS Then
  5915.                Begin
  5916.                     FDBProcs.SQLNumResultCols(ahstmt,cols);
  5917.                     If cols>9 Then cols:=9;
  5918.                     For I := 0 To cols-1 Do
  5919.                       FDBProcs.SQLBindCol(ahstmt, I + 1, SQL_C_CHAR, C[I], 255, OutLen[I]);
  5920.  
  5921.                     rc:=FDBProcs.SQLFetch(ahstmt);
  5922.                     While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  5923.                     Begin
  5924.                          If OutLen[5]<>SQL_NULL_DATA Then
  5925.                          Begin
  5926.                               Move(C[5],S[1],OutLen[5]);
  5927.                               S[0]:=Chr(OutLen[5]);
  5928.                               If S[length(s)]=#0 Then
  5929.                                If length(S)>0 Then dec(S[0]);
  5930.                               If OutLen[4]<>SQL_NULL_DATA Then
  5931.                               Begin
  5932.                                    Move(C[4],S1[1],OutLen[4]);
  5933.                                    S1[0]:=Chr(OutLen[4]);
  5934.                                    If S1[length(S1)]=#0 Then
  5935.                                     If length(S1)>0 Then dec(S1[0]);
  5936.                                    If S1<>'' Then S:=S1+'.'+S;
  5937.                               End;
  5938.  
  5939.                               //get column name
  5940.                               If OutLen[8]<>SQL_NULL_DATA Then
  5941.                               Begin
  5942.                                    Move(C[8],Fields[1],OutLen[8]);
  5943.                                    Fields[0]:=Chr(OutLen[8]);
  5944.                                    If Fields[length(Fields)]=#0 Then
  5945.                                     If length(Fields)>0 Then dec(Fields[0]);
  5946.                               End;
  5947.  
  5948.                               If ((s<>'')And(Fields<>'')) Then
  5949.                               Begin
  5950.                                   If FIndexDefs.IndexOf(s)>=0 Then
  5951.                                   Begin
  5952.                                        IndexDef:=FIndexDefs.Items[FIndexDefs.IndexOf(s)];
  5953.                                        AssignStr(IndexDef.FFields,IndexDef.Fields+';'+Fields);
  5954.                                   End
  5955.                                   Else FIndexDefs.Add(s,Fields,[]);
  5956.                               End;
  5957.                          End;
  5958.                          rc:=FDBProcs.SQLFetch(ahstmt);
  5959.                     End;
  5960.                End
  5961.                Else
  5962.                Begin
  5963.                     S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,ahstmt);
  5964.                     FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5965.                     DataBaseError(s);
  5966.                End;
  5967.  
  5968.                FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  5969.                LeaveSQLProcessing;
  5970.           End;
  5971.  
  5972.           If Not OldOpen Then DoClose;
  5973.           FActive:=OldActive;
  5974.      End;
  5975. End;
  5976.  
  5977. Procedure TTable.UpdateFieldDefs;
  5978. Begin
  5979.      QueryTable;
  5980. End;
  5981.  
  5982. Procedure TTable.QueryTable;
  5983. Var
  5984.     resultCols:SQLSMALLINT;
  5985.     colName:cstring;
  5986.     colNameLen:SQLSMALLINT;
  5987.     colType:SQLSMALLINT;
  5988.     Size:SQLUINTEGER;
  5989.     Scale:SQLSMALLINT;
  5990.     I:LongInt;
  5991.     S:String;
  5992.     Select:PChar;
  5993.     Temp:TStringList;
  5994.     t2:String;
  5995.     J,j1:String;
  5996.     First:Boolean;
  5997.     B:Byte;
  5998.     field:TField;
  5999.     MasterTable:TTable;
  6000.     rc:SQLRETURN;
  6001.     pfNullable:SQLSMALLINT;
  6002.     FieldDef:TFieldDef;
  6003. Label lll;
  6004. Begin
  6005.      If Not FOpened Then Exit;
  6006.  
  6007.      //Erase All tables And Reset Object
  6008.      CloseStmt;
  6009.      FFieldDefs.Clear;
  6010.      FCurrentRow:=-1;
  6011.      FCurrentField:=0;
  6012.  
  6013.      If ((Self Is TTable)And(TTable(Self).FMasterSource<>Nil)And
  6014.         (TTable(Self).FMasterSource.DataSet Is TTable)) Then
  6015.      Begin
  6016.           Temp.Create;
  6017.  
  6018.           t2:=TTable(TTable(Self).FMasterSource.DataSet).TableName;
  6019.           Temp.Add('SELECT * FROM '+TableName);
  6020.  
  6021.           S:=TTable(Self).MasterFields;
  6022.           First:=True;
  6023.           MasterTable:=TTable(TTable(Self).FMasterSource.DataSet);
  6024.           While S<>'' Do
  6025.           Begin
  6026.                B:=Pos(';',S);
  6027.                If B<>0 Then
  6028.                Begin
  6029.                     J:=Copy(S,1,B-1);
  6030.                     System.Delete(S,1,B);
  6031.                End
  6032.                Else
  6033.                Begin
  6034.                     J:=S;
  6035.                     S:='';
  6036.                End;
  6037.  
  6038.                B:=Pos('=',J);
  6039.                If B<>0 Then
  6040.                Begin
  6041.                     j1:=System.Copy(J,B+1,255);
  6042.                     J[0]:=Chr(B-1);
  6043.                End
  6044.                Else j1:=J;
  6045.  
  6046.                field:=MasterTable.FieldFromColumnName[j1];
  6047.                If field=Nil Then
  6048.                Begin
  6049.                     Temp.Destroy;
  6050.                     Goto lll;
  6051.                End;
  6052.  
  6053.                j1:=Field2String(field);
  6054.  
  6055.                If First Then Temp.Add('WHERE '+J+'='+j1)
  6056.                Else Temp.Add('AND '+J+'='+j1);
  6057.                First:=False;
  6058.           End;
  6059.           Select:=Temp.GetText;
  6060.  
  6061.           Temp.Destroy;
  6062.      End
  6063.      Else
  6064.      Begin
  6065. lll:
  6066.           Select:=FSelect.GetText;
  6067.      End;
  6068.  
  6069.      If Select=Nil Then
  6070.      Begin
  6071.           DoClose;
  6072.           Exit;
  6073.      End;
  6074.  
  6075.      While ((Select^<>'')And(Select^[length(Select^)-1] In [#13,#10])) Do
  6076.         Select^[length(Select^)-1]:=#0;
  6077.  
  6078.      EnterSQLProcessing;
  6079.      FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,FDBProcs.ahstmt);
  6080.  
  6081.      Try
  6082.         If FDBProcs.SQLExecDirect(FDBProcs.ahstmt,Select^,SQL_NTS)<>SQL_SUCCESS Then
  6083.         Begin
  6084.               S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  6085.               CloseStmt;
  6086.               DoClose;
  6087.               SQLError('Error executing SELECT statement: '+S);
  6088.         End;
  6089.  
  6090.         {The driver determines the number of rows in the result set}
  6091.         rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  6092.         FMaxRows:=0;
  6093.         While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  6094.         Begin
  6095.              inc(FMaxRows);
  6096.              rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  6097.         End;
  6098.         FDBProcs.SQLFreeStmt(FDBProcs.ahstmt,SQL_DROP);
  6099.         FDBProcs.ahstmt:=0;
  6100.  
  6101.         {The driver recreates the result set}
  6102.         FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,FDBProcs.ahstmt);
  6103.         FDBProcs.SQLSetStmtOption(FDBProcs.ahstmt,SQL_CURSOR_TYPE,SQL_CURSOR_KEYSET_DRIVEN);
  6104.         If FDBProcs.SQLExecDirect(FDBProcs.ahstmt,Select^,SQL_NTS)<>SQL_SUCCESS Then
  6105.         Begin
  6106.              S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  6107.              CloseStmt;
  6108.              DoClose;
  6109.              SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S);
  6110.         End;
  6111.  
  6112.         {The driver determines the result set columns}
  6113.         FDBProcs.SQLNumResultCols(FDBProcs.ahstmt,resultCols);
  6114.         If resultCols=0 Then //Not A Select statement
  6115.         Begin
  6116.              CloseStmt;
  6117.              SQLError(LoadNLSStr(SEmptyResultSet));
  6118.         End
  6119.         Else
  6120.         Begin
  6121.              {Store Result Columns}
  6122.              For I := 0 To resultCols-1 Do
  6123.              Begin
  6124.                    Size:=0;
  6125.                    FDBProcs.SQLDescribeCol(FDBProcs.ahstmt, I + 1, colName,
  6126.                      SizeOf(colName), colNameLen, colType, Size, Scale, pfNullable);
  6127.                    If Size>65535 Then Size:=4096;
  6128.                    S:=colName;
  6129.  
  6130.                    Case ColType Of
  6131.                       SQL_REAL:Size:=4;
  6132.                       SQL_FLOAT,SQL_DOUBLE,SQL_NUMERIC:Size:=8;
  6133.                    End; //case
  6134.  
  6135.                    FFieldDefs.Add(S, MapSQLType(colType), Size, pfNullable=SQL_NO_NULLS);
  6136.  
  6137.                    FieldDef := FFieldDefs[I];
  6138.                    FieldDef.Precision := Scale;
  6139.              End;
  6140.  
  6141.              FCurrentRow:=0;   {First Row}
  6142.              FCurrentField:=0; {First field}
  6143.         End;
  6144.  
  6145.         Post;  //Commit All transactions Until here
  6146.         StrDispose(Select);
  6147.         LeaveSQLProcessing;
  6148.      Except
  6149.         ON E:ESQLError Do
  6150.         Begin
  6151.              StrDispose(Select);
  6152.              CloseStmt;
  6153.              LeaveSQLProcessing;
  6154.              ErrorBox(E.Message);
  6155.         End;
  6156.         Else
  6157.         Begin
  6158.              StrDispose(Select);
  6159.              CloseStmt;
  6160.              LeaveSQLProcessing;
  6161.              Raise;
  6162.         End;
  6163.      End;
  6164.  
  6165.      DataChange(deDataBaseChanged);
  6166. End;
  6167.  
  6168.  
  6169. {
  6170. ╔═══════════════════════════════════════════════════════════════════════════╗
  6171. ║                                                                           ║
  6172. ║ Speed-Pascal/2 Version 2.0                                                ║
  6173. ║                                                                           ║
  6174. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6175. ║                                                                           ║
  6176. ║ This section: TQuery Class Implementation                                 ║
  6177. ║                                                                           ║
  6178. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6179. ║                                                                           ║
  6180. ╚═══════════════════════════════════════════════════════════════════════════╝
  6181. }
  6182.  
  6183. Procedure TQuery.RefreshTable;
  6184. Begin
  6185.      If ((ComponentState*[csReading]<>[])Or(FDataSetLocked)) Then
  6186.      Begin
  6187.           FRefreshOnLoad:=FActive;
  6188.           Exit;
  6189.      End;
  6190.      DoOpen;
  6191.      If Not FOpened Then Exit;
  6192.      If FSelect.Count<>0 Then QueryTable;
  6193. End;
  6194.  
  6195. Procedure TQuery.SetSQL(NewValue:TStrings);
  6196. Begin
  6197.      If ((NewValue=FSelect)Or(NewValue.Equals(FSelect))) Then Exit; {!}
  6198.      FSelect.Assign(NewValue);
  6199.      If FActive Then RefreshTable;
  6200. End;
  6201.  
  6202. Procedure TQuery.SetupComponent;
  6203. Begin
  6204.      Inherited SetupComponent;
  6205.      ReadOnly:=True;
  6206.      Name:='Query';
  6207. End;
  6208.  
  6209. Function TQuery.WriteSCUResource(Stream:TResourceStream):Boolean;
  6210. Var aText:PChar;
  6211. Begin
  6212.      Result:=Inherited WriteSCUResource(Stream);
  6213.      If Result=False Then Exit;
  6214.      aText:=FSelect.GetText;
  6215.      If aText<>Nil Then
  6216.      Begin
  6217.           Result:=Stream.NewResourceEntry(rnDBQuery,aText^,Length(aText^)+1);
  6218.           StrDispose(aText);
  6219.      End;
  6220. End;
  6221.  
  6222. Procedure TQuery.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  6223. Var aText:PChar;
  6224. Begin
  6225.      If ResName = rnDBQuery Then
  6226.      Begin
  6227.           aText:=@Data;
  6228.           FSelect.SetText(aText);
  6229.      End
  6230.      Else Inherited ReadSCUResource(ResName,Data,DataLen)
  6231. End;
  6232.  
  6233. {
  6234. ╔═══════════════════════════════════════════════════════════════════════════╗
  6235. ║                                                                           ║
  6236. ║ Speed-Pascal/2 Version 2.0                                                ║
  6237. ║                                                                           ║
  6238. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6239. ║                                                                           ║
  6240. ║ This section: TParam Class Implementation                                 ║
  6241. ║                                                                           ║
  6242. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6243. ║                                                                           ║
  6244. ╚═══════════════════════════════════════════════════════════════════════════╝
  6245. }
  6246.  
  6247. Procedure TParam.SetAsBCD(Value: Currency);
  6248. Begin
  6249.      FNull := False;
  6250.      FBound := True;
  6251.      FData:=Value;
  6252. End;
  6253.  
  6254. Procedure TParam.SetAsBoolean(Value: Boolean);
  6255. Begin
  6256.      FNull := False;
  6257.      FBound := True;
  6258.      FData:=Value;
  6259. End;
  6260.  
  6261. Procedure TParam.SetAsCurrency(Value:Extended);
  6262. Begin
  6263.     FNull := False;
  6264.     FBound := True;
  6265.     FData:=Value;
  6266. End;
  6267.  
  6268. Procedure TParam.SetAsDate(Value: TDateTime);
  6269. Begin
  6270.     FNull := False;
  6271.     FBound := True;
  6272.     FData:=Value;
  6273. End;
  6274.  
  6275. Procedure TParam.SetAsDateTime(Value: TDateTime);
  6276. Begin
  6277.     FNull := False;
  6278.     FBound := True;
  6279.     FData:=Value;
  6280. End;
  6281.  
  6282. Procedure TParam.SetAsFloat(Const Value:Extended);
  6283. Begin
  6284.      FNull := False;
  6285.      FBound := True;
  6286.      FData:=Value;
  6287. End;
  6288.  
  6289. Procedure TParam.SetAsInteger(Value: Longint);
  6290. Begin
  6291.      FNull := False;
  6292.      FBound := True;
  6293.      FData:=Value;
  6294. End;
  6295.  
  6296. Procedure TParam.SetAsString(Const Value:String);
  6297. Begin
  6298.      FNull := False;
  6299.      FBound := True;
  6300.      FData:=Value;
  6301. End;
  6302.  
  6303. Procedure TParam.SetAsSmallInt(Value: LongInt);
  6304. Begin
  6305.      FNull := False;
  6306.      FBound := True;
  6307.      FData:=Value;
  6308. End;
  6309.  
  6310. Procedure TParam.SetAsTime(Value: TDateTime);
  6311. Begin
  6312.     FNull := False;
  6313.     FBound := True;
  6314.     FData:=Value;
  6315. End;
  6316.  
  6317. Procedure TParam.SetAsVariant(Value: Variant);
  6318. Begin
  6319.     FNull := False;
  6320.     FBound := True;
  6321.     Case VarType(Value) Of
  6322.        varByte,varSmallint:DataType:=ftSmallInt;
  6323.        varInteger,varLongInt,varLongWord:DataType:=ftInteger;
  6324.        varCurrency:DataType:=ftBCD;
  6325.        varSingle,varDouble,varExtended:DataType:=ftFloat;
  6326.        varBoolean:DataType:=ftBoolean;
  6327.        varString:DataType:=ftString;
  6328.        Else DataType := ftUnknown;
  6329.     End;
  6330.     FData := Value;
  6331. End;
  6332.  
  6333. Procedure TParam.SetAsWord(Value: LongInt);
  6334. Begin
  6335.      FNull := False;
  6336.      FBound := True;
  6337.      FData:=Value;
  6338. End;
  6339.  
  6340. Function TParam.GetAsBCD: Currency;
  6341. Begin
  6342.      Result:=FData;
  6343. End;
  6344.  
  6345. Function TParam.GetAsBoolean: Boolean;
  6346. Begin
  6347.      Result:=FData;
  6348. End;
  6349.  
  6350. Function TParam.GetAsDateTime: TDateTime;
  6351. Begin
  6352.      Result:=FData;
  6353. End;
  6354.  
  6355. Function TParam.GetAsFloat:Extended;
  6356. Begin
  6357.      Result:=FData;
  6358. End;
  6359.  
  6360. Function TParam.GetAsInteger: Longint;
  6361. Begin
  6362.      Result:=FData;
  6363. End;
  6364.  
  6365. Function TParam.GetAsString:String;
  6366. Begin
  6367.      Result:=FData;
  6368. End;
  6369.  
  6370. Function TParam.GetAsVariant: Variant;
  6371. Begin
  6372.      Result:=FData;
  6373. End;
  6374.  
  6375. Function TParam.IsEqual(Value: TParam): Boolean;
  6376. Begin
  6377.      result:=False;
  6378.      If ParamType=Value.ParamType Then
  6379.        If Bound=Value.Bound Then
  6380.          If VarType(FData)=VarType(Value.FData) Then
  6381.            If Name=Value.Name Then
  6382.              If FData=Value.FData Then result:=True;
  6383. End;
  6384.  
  6385. Procedure TParam.SetDataType(Value: TFieldType);
  6386. Begin
  6387.      FData := 0;
  6388.      FDataType := Value;
  6389. End;
  6390.  
  6391. Procedure TParam.SetText(Const Value:String);
  6392. Begin
  6393.      FNull := False;
  6394.      FBound := True;
  6395.      If FDataType=ftUnknown Then DataType:=ftString;
  6396.      FData := Value;
  6397.      Case DataType of
  6398.        ftBoolean:FData:=Boolean(FData);
  6399.        ftInteger,ftSmallInt,ftWord: FData := Integer(FData);
  6400.        ftDateTime,ftTime,ftDate:FData:=Extended(FData);
  6401.        ftBCD:FData:=Currency(FData);
  6402.        ftCurrency,ftFloat:FData:=Extended(FData);
  6403.      End;
  6404. End;
  6405.  
  6406. Constructor TParam.Create(AParamList:TParams;AParamType: TParamType);
  6407. Begin
  6408.     FParamList:=AParamList;
  6409.     If FParamList<>Nil Then FParamList.AddParam(Self);
  6410.     FParamType := AParamType;
  6411.     DataType := ftUnknown;
  6412.     FBound := False;
  6413. End;
  6414.  
  6415. Destructor TParam.Destroy;
  6416. Begin
  6417.     If FParamList<>Nil Then FParamList.RemoveParam(Self);
  6418.     If FName<>Nil Then FreeMem(FName,length(FName^)+1);
  6419.     Inherited Destroy;
  6420. End;
  6421.  
  6422. Function TParam.GetName:String;
  6423. Begin
  6424.     If FName=Nil Then result:=''
  6425.     Else Result:=FName^;
  6426. End;
  6427.  
  6428. Procedure TParam.SetName(Const NewValue:String);
  6429. Begin
  6430.     If FName<>Nil Then FreeMem(FName,length(FName^)+1);
  6431.     GetMem(FName,length(NewValue)+1);
  6432.     FName^:=NewValue;
  6433. End;
  6434.  
  6435. Procedure TParam.Assign(Param: TParam);
  6436. Begin
  6437.     If Param=Nil Then exit;
  6438.     DataType:=Param.DataType;
  6439.     If not Param.IsNull Then
  6440.     Begin
  6441.       FNull := False;
  6442.       FBound := True;
  6443.       FData := Param.FData;
  6444.     End
  6445.     Else Clear;
  6446.     Name:=Param.Name;
  6447.     FBound:=Param.Bound;
  6448.     If FParamType=ptUnknown Then FParamType:=Param.ParamType;
  6449. End;
  6450.  
  6451. Procedure TParam.AssignField(Field: TField);
  6452. Begin
  6453.     If Field=Nil Then exit;
  6454.     DataType:=Field.DataType;
  6455.     If not Field.IsNull Then
  6456.     Begin
  6457.       FNull := False;
  6458.       FBound := True;
  6459.       FData := Field.AsString;
  6460.     End
  6461.     Else Clear;
  6462.     Name:=Field.FieldName;
  6463.     FBound:=True;
  6464. End;
  6465.  
  6466. Procedure TParam.AssignFieldValue(Field:TField;Const Value: Variant);
  6467. Begin
  6468.     If Field=Nil Then exit;
  6469.     DataType := Field.DataType;
  6470.     If VarIsNull(Value) Then Clear
  6471.     Else
  6472.     Begin
  6473.       FNull := False;
  6474.       FBound := True;
  6475.       FData := Value;
  6476.     End;
  6477.     FBound := True;
  6478. End;
  6479.  
  6480. Procedure TParam.Clear;
  6481. Begin
  6482.      FData:=0;
  6483.      FNull:=True;
  6484. End;
  6485.  
  6486. {
  6487. ╔═══════════════════════════════════════════════════════════════════════════╗
  6488. ║                                                                           ║
  6489. ║ Speed-Pascal/2 Version 2.0                                                ║
  6490. ║                                                                           ║
  6491. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6492. ║                                                                           ║
  6493. ║ This section: TParams Class Implementation                                ║
  6494. ║                                                                           ║
  6495. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6496. ║                                                                           ║
  6497. ╚═══════════════════════════════════════════════════════════════════════════╝
  6498. }
  6499.  
  6500. Function TParams.GetParam(Index: Word): TParam;
  6501. Begin
  6502.      result:=FItems[Index];
  6503. End;
  6504.  
  6505. Function TParams.GetParamValue(Const ParamName:String): Variant;
  6506. Var Param:TParam;
  6507. Begin
  6508.      Param:=ParamByName(ParamName);
  6509.      If Param<>Nil Then Result:=Param.Value;
  6510. End;
  6511.  
  6512. Procedure TParams.SetParamValue(Const ParamName:String;Const Value: Variant);
  6513. Var Param:TParam;
  6514. Begin
  6515.     Param:=ParamByName(ParamName);
  6516.     If Param<>Nil Then Param.Value:=Value;
  6517. End;
  6518.  
  6519. Constructor TParams.Create;
  6520. Begin
  6521.      Inherited Create;
  6522.      FItems.Create;
  6523. End;
  6524.  
  6525. Destructor TParams.Destroy;
  6526. Begin
  6527.      Clear;
  6528.      FItems.Destroy;
  6529.      Inherited Destroy;
  6530. End;
  6531.  
  6532. Procedure TParams.AddParam(Value: TParam);
  6533. Begin
  6534.     FItems.Add(Value);
  6535. End;
  6536.  
  6537. Procedure TParams.RemoveParam(Value: TParam);
  6538. Begin
  6539.      FItems.Remove(Value);
  6540.      If Value.FParamList=Self Then Value.FParamList:=Nil;
  6541. End;
  6542.  
  6543. Function TParams.CreateParam(FldType:TFieldType;Const ParamName:String;ParamType: TParamType): TParam;
  6544. Begin
  6545.      Result.Create(Self,ParamType);
  6546.      Result.Name:=ParamName;
  6547.      Result.DataType := FldType;
  6548. End;
  6549.  
  6550. Function TParams.Count:LongInt;
  6551. Begin
  6552.      Result:=FItems.Count;
  6553. End;
  6554.  
  6555. Procedure TParams.Clear;
  6556. Var t:LongInt;
  6557.     Param:TParam;
  6558. Begin
  6559.      For t:=FItems.Count-1 DownTo 0 Do
  6560.      Begin
  6561.           Param:=FItems[t];
  6562.           Param.Destroy;
  6563.      End;
  6564. End;
  6565.  
  6566. Function TParams.IsEqual(Value:TParams): Boolean;
  6567. Var t:LongInt;
  6568. Begin
  6569.   Result:=False;
  6570.   If FItems.Count=Value.Count Then
  6571.     For t:=0 To FItems.Count-1 Do If not Items[t].IsEqual(Value.Items[t]) Then exit;
  6572. End;
  6573.  
  6574. Function TParams.ParamByName(Const Value:String):TParam;
  6575. Var t:LongInt;
  6576. Begin
  6577.   For t:=0 To FItems.Count - 1 Do
  6578.   Begin
  6579.     Result:=FItems[t];
  6580.     If Result.Name=Value Then Exit;
  6581.   End;
  6582.   DatabaseError('Invalid stored procedure parameter name: '+Value);
  6583. End;
  6584.  
  6585.  
  6586. {
  6587. ╔═══════════════════════════════════════════════════════════════════════════╗
  6588. ║                                                                           ║
  6589. ║ Speed-Pascal/2 Version 2.0                                                ║
  6590. ║                                                                           ║
  6591. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  6592. ║                                                                           ║
  6593. ║ This section: TStoredProc Class Implementation                            ║
  6594. ║                                                                           ║
  6595. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  6596. ║                                                                           ║
  6597. ╚═══════════════════════════════════════════════════════════════════════════╝
  6598. }
  6599.  
  6600. Function TStoredProc.GetParamCount:Word;
  6601. Begin
  6602.     Result:=FParams.Count;
  6603. End;
  6604.  
  6605. Procedure TStoredProc.SetDefaultParams;
  6606. Var
  6607.    ahstmt:SQLHSTMT;
  6608.    cols:SQLSMALLINT;
  6609.    I,t:LongInt;
  6610.    C:Array[0..12] Of cstring;
  6611.    OutLen:Array[0..12] Of SQLINTEGER;
  6612.    si:SQLSMALLINT;
  6613.    rc:SQLRETURN;
  6614.    S:String;
  6615.    Cs:CString;
  6616.    OldActive:Boolean;
  6617.    OldOpen:Boolean;
  6618.    pt:TParamType;
  6619.    ft:TFieldType;
  6620.    cc:Integer;
  6621.    Names:TStringList;
  6622.    Types,Modes:TList;
  6623. Label weiter;
  6624. Begin
  6625.     //determine parameter from driver
  6626.     FParams.Clear;
  6627.  
  6628.     If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then
  6629.       If StoredProcName<>'' Then
  6630.     Begin
  6631.         OldActive:=FActive;
  6632.         OldOpen:=FOpened;
  6633.         If Designed Then
  6634.           If Not FOpened Then
  6635.           Begin
  6636.               FActive:=True;
  6637.               DoOpen;
  6638.               If Not FOpened Then Active:=False;
  6639.           End;
  6640.  
  6641.         If FOpened Then
  6642.         Begin
  6643.              If FDBProcs.DBType=Native_Oracle7 Then
  6644.              Begin
  6645.                   Names.Create;
  6646.                   Types.Create;
  6647.                   Modes.Create;
  6648.                   If not FDBProcs.Oracle7GetProcParams(FProcName,@FDBProcs,Names,Types,Modes) Then
  6649.                   Begin
  6650.                        ErrorBox(SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt));
  6651.                   End
  6652.                   Else
  6653.                   Begin
  6654.                        For t:=0 To Names.Count-1 Do
  6655.                        Begin
  6656.                             i:=LongInt(Types[t]);
  6657.                             ft:=MapSQLType(i);
  6658.                             i:=LongInt(Modes[t]);
  6659.                             If i>=16 Then pt:=ptResult
  6660.                             Else Case i Of
  6661.                               0:pt:=ptInput;
  6662.                               1:pt:=ptOutput;
  6663.                               Else pt:=ptInputOutput;
  6664.                             End; //case
  6665.                             FParams.CreateParam(ft,Names[t],pt);
  6666.                        End;
  6667.                   End;
  6668.                   Names.Destroy;
  6669.                   Types.Destroy;
  6670.                   Modes.Destroy;
  6671.              End
  6672.              Else
  6673.              Begin
  6674.                   EnterSQLProcessing;
  6675.                   FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,ahstmt);
  6676.  
  6677.                   Cs:=FProcName;
  6678.                   If FDBProcs.SQLProcedureColumns(ahstmt,Nil,0,Nil,0,Cs,length(FProcName),Nil,0)=SQL_SUCCESS Then
  6679.                   Begin
  6680.                        FDBProcs.SQLNumResultCols(ahstmt,cols);
  6681.                        If cols>13 Then cols:=13;
  6682.                        For I := 0 To cols-1 Do
  6683.                          FDBProcs.SQLBindCol(ahstmt, I + 1, SQL_C_CHAR, C[I], 255, OutLen[I]);
  6684.                        rc:=FDBProcs.SQLFetch(ahstmt);
  6685.                        While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  6686.                        Begin
  6687.                            If OutLen[3]<>SQL_NULL_DATA Then //Parameter name
  6688.                            Begin
  6689.                                 Move(C[4],S[1],OutLen[4]); //Parameter type
  6690.                                 S[0]:=Chr(OutLen[4]);
  6691.                                 Val(S,si,cc);
  6692.                                 If cc<>0 Then goto weiter; //illegal
  6693.  
  6694.                                 Case si Of
  6695.                                   SQL_PARAM_INPUT:pt:=ptInput;
  6696.                                   SQL_PARAM_OUTPUT:pt:=ptOutput;
  6697.                                   SQL_PARAM_INPUT_OUTPUT:pt:=ptInputOutput;
  6698.                                   SQL_RETURN_VALUE:pt:=ptResult;
  6699.                                   SQL_RESULT_COL:pt:=ptResultSet;
  6700.                                   Else pt:=ptUnknown;
  6701.                                 End;
  6702.  
  6703.                                 Move(C[5],S[1],OutLen[5]); //Parameter data type
  6704.                                 S[0]:=Chr(OutLen[5]);
  6705.                                 Val(S,si,cc);
  6706.                                 If cc<>0 Then goto weiter; //illegal
  6707.  
  6708.                                 ft:=MapSQLType(si);
  6709.  
  6710.                                 Move(C[3],S[1],OutLen[3]);
  6711.                                 S[0]:=Chr(OutLen[3]);
  6712.  
  6713.                                 FParams.CreateParam(ft,S,pt);
  6714.                            End;
  6715. weiter:
  6716.                            rc:=FDBProcs.SQLFetch(ahstmt);
  6717.                        End;
  6718.                   End;
  6719.  
  6720.                   FDBProcs.SQLFreeStmt(ahstmt,SQL_DROP);
  6721.                   LeaveSQLProcessing;
  6722.              End;
  6723.         End;
  6724.  
  6725.         If Designed Then
  6726.         Begin
  6727.             If Not OldOpen Then DoClose;
  6728.             FActive:=OldActive;
  6729.         End;
  6730.     End;
  6731. End;
  6732.  
  6733. Procedure TStoredProc.SetPrepared(NewValue:Boolean);
  6734. Begin
  6735.      If not NewValue Then
  6736.      Begin
  6737.           FPrepared:=False;
  6738.           exit;
  6739.      End;
  6740.  
  6741.      If ((ComponentState*[csReading]=[])And(Not FDataSetLocked)) Then DoOpen;
  6742.  
  6743.      If FOpened Then FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,FDBProcs.ahstmt);
  6744.  
  6745.      FPrepared:=True;
  6746. End;
  6747.  
  6748. Procedure TStoredProc.SetParams(NewValue:TParams);
  6749. Var t:LongInt;
  6750. Begin
  6751.     FParams.Clear;
  6752.     For t:=0 To NewValue.Count-1 Do
  6753.       FParams.CreateParam(NewValue[t].DataType,NewValue[t].Name,NewValue[t].ParamType);
  6754. End;
  6755.  
  6756. Procedure TStoredProc.SetStoredProcName(NewValue:String);
  6757. Begin
  6758.      CheckInactive;
  6759.      FProcName:=NewValue;
  6760.      FParams.Clear;
  6761. End;
  6762.  
  6763. Constructor TStoredProc.Create(AOwner: TComponent);
  6764. Begin
  6765.      Inherited Create(AOwner);
  6766.      ReadOnly:=True;
  6767.      Name:='StoredProc';
  6768.      FParams.Create;
  6769. End;
  6770.  
  6771. Destructor TStoredProc.Destroy;
  6772. Begin
  6773.      FParams.Destroy;
  6774.      Inherited Destroy;
  6775. End;
  6776.  
  6777. Procedure TStoredProc.CopyParams(Value:TParams);
  6778. Begin
  6779.      Params:=Value;
  6780. End;
  6781.  
  6782. Procedure TStoredProc.ExecProc;
  6783. Var rc:SQLRETURN;
  6784.     ReturnsResultSet:Boolean;
  6785.     t:LongInt;
  6786.     Param:TParam;
  6787.     s:String;
  6788.     c:CString;
  6789.     resultCols:SQLSMALLINT;
  6790.     I:LongInt;
  6791.     Size:SQLUINTEGER;
  6792.     colName:CString;
  6793.     colNameLen:SQLSMALLINT;
  6794.     colType:SQLSMALLINT;
  6795.     Scale:SQLSMALLINT;
  6796.     FieldDef:TFieldDef;
  6797.  
  6798.     ptsql,ctype,sqltype,Len:SQLSMALLINT;
  6799.     p:Pointer;
  6800.  
  6801.     Function ExecSQL:SQLRETURN;
  6802.     Var s:String;
  6803.         c:CString;
  6804.         t:LongInt;
  6805.     Begin
  6806.           If FDBProcs.DBType=Native_Oracle7 Then s:=StoredProcName+'('
  6807.           Else s:='call '+StoredProcName+'(';
  6808.           For t:=0 To FParams.Count-1 Do
  6809.           Begin
  6810.                Param:=FParams[t];
  6811.                If Param.ParamType=ptResultSet Then
  6812.                Begin
  6813.                     ReturnsResultSet:=True;
  6814.                     continue;
  6815.                End;
  6816.  
  6817.                If FDBProcs.DBType=Native_Oracle7 Then
  6818.                Begin
  6819.                     If ((Param.ParamType=ptResult)And(s[1]<>':')) Then s:=':p0='+s
  6820.                     Else
  6821.                     Begin
  6822.                          If s[length(s)]<>'(' Then s:=s+',';
  6823.                          s:=s+':p'+tostr(t+1);
  6824.                     End;
  6825.                End
  6826.                Else
  6827.                Begin
  6828.                     If ((Param.ParamType=ptResult)And(s[1]<>'?')) Then s:='?='+s
  6829.                     Else
  6830.                     Begin
  6831.                          If s[length(s)]<>'(' Then s:=s+',';
  6832.                          s:=s+'?';
  6833.                     End;
  6834.                End;
  6835.           End;
  6836.  
  6837.           If FDBProcs.DBType=Native_Oracle7 Then
  6838.             s:='BEGIN'+#10+s+');'#10+'END;'
  6839.           Else
  6840.             s:='{'+s+')}';
  6841.           c:=s;
  6842.           Result:=FDBProcs.SQLExecDirect(FDBProcs.ahstmt,c,SQL_NTS);
  6843.     End;
  6844.  
  6845.     Procedure BindParameters;
  6846.     Var i:LongInt;
  6847.         Param:TParam;
  6848.     Begin
  6849.      For i:=0 To FParams.Count-1 Do
  6850.      Begin
  6851.           Param:=FParams[i];
  6852.  
  6853.           Case Param.ParamType Of
  6854.              ptInput:ptsql:=SQL_PARAM_INPUT;
  6855.              ptOutput:ptsql:=SQL_PARAM_OUTPUT;
  6856.              ptResult:
  6857.              Begin
  6858.                   If FDBProcs.DBType=Native_Oracle7 Then ptsql:=SQL_PARAM_RESULT
  6859.                   Else ptsql:=SQL_PARAM_OUTPUT;
  6860.              End;
  6861.              ptInputOutput:ptsql:=SQL_PARAM_INPUT_OUTPUT;
  6862.              Else Continue; //Next Parameter
  6863.           End;
  6864.  
  6865.           Case Param.DataType Of
  6866.              ftString:
  6867.              Begin
  6868.                   sqlType:=SQL_CHAR;
  6869.                   cType:=SQL_C_CHAR;
  6870.                   p:=@Param.FResultNTS;
  6871.                   Param.FResultNTS:=Param.AsString;
  6872.                   Len:=Length(Param.FResultNTS);
  6873.                   Param.FOutLen:=SQL_NTS;
  6874.              End;
  6875.              ftCurrency:
  6876.              Begin
  6877.                   sqlType:=SQL_NUMERIC;
  6878.                   cType:=SQL_C_FLOAT;
  6879.                   Len:=10;
  6880.                   p:=@Param.FResultExtended;
  6881.                   Param.FResultExtended:=Param.AsFloat;
  6882.                   Param.FOutLen:=10;
  6883.              End;
  6884.              ftInteger:
  6885.              Begin
  6886.                   sqlType:=SQL_INTEGER;
  6887.                   cType:=SQL_C_LONG;
  6888.                   Len:=4;
  6889.                   p:=@Param.FResultLongInt;
  6890.                   Param.FResultLongInt:=Param.AsInteger;
  6891.                   Param.FOutLen:=4;
  6892.              End;
  6893.              ftSmallInt:
  6894.              Begin
  6895.                   sqlType:=SQL_SMALLINT;
  6896.                   cType:=SQL_C_SHORT;
  6897.                   Len:=2;
  6898.                   p:=@Param.FResultSmallInt;
  6899.                   Param.FResultSmallInt:=Param.AsSmallInt;
  6900.                   Param.FOutLen:=2;
  6901.              End;
  6902.              ftFloat:
  6903.              Begin
  6904.                   sqlType:=SQL_FLOAT;
  6905.                   cType:=SQL_C_FLOAT;
  6906.                   Len:=10;
  6907.                   p:=@Param.FResultExtended;
  6908.                   Param.FResultExtended:=Param.AsFloat;
  6909.                   Param.FOutLen:=10;
  6910.              End;
  6911.              ftDate:
  6912.              Begin
  6913.                   sqlType:=SQL_DATE;
  6914.                   cType:=SQL_C_DATE;
  6915.                   Len:=sizeof(Param.FResultDate);
  6916.                   p:=@Param.FResultDate;
  6917.                   DecodeDate(Param.AsDate,Param.FResultDate.Year,Param.FResultDate.Month,Param.FResultDate.Day);
  6918.                   Param.FOutLen:=sizeof(Param.FResultDate);
  6919.              End;
  6920.              ftTime:
  6921.              Begin
  6922.                   sqlType:=SQL_TIME;
  6923.                   cType:=SQL_C_TIME;
  6924.                   Len:=sizeof(Param.FResultTime);
  6925.                   p:=@Param.FResultTime;
  6926.                   RoundDecodeTime(Param.AsTime,Param.FResultTime.Hour,Param.FResultTime.Minute,Param.FResultTime.Second);
  6927.                   Param.FOutLen:=sizeof(Param.FResultTime);
  6928.              End;
  6929.              ftDateTime:
  6930.              Begin
  6931.                   sqlType:=SQL_TIMESTAMP;
  6932.                   cType:=SQL_C_TIMESTAMP;
  6933.                   Len:=sizeof(Param.FResultDateTime);
  6934.                   p:=@Param.FResultDateTime;
  6935.                   DecodeDate(Param.AsDate,Param.FResultDateTime.Year,Param.FResultDateTime.Month,Param.FResultDateTime.Day);
  6936.                   RoundDecodeTime(Param.AsTime,Param.FResultDateTime.Hour,Param.FResultDateTime.Minute,Param.FResultDateTime.Second);
  6937.                   Param.FOutLen:=sizeof(Param.FResultDateTime);
  6938.              End;
  6939.              ftMemo:
  6940.              Begin
  6941.                   sqlType:=SQL_LONGVARCHAR;
  6942.                   cType:=SQL_C_CHAR;
  6943.                   Len:=0; //??
  6944.                   p:=Nil; //???
  6945.                   Param.FOutLen:=0; //?? current len
  6946.              End;
  6947.              ftBlob:
  6948.              Begin
  6949.                   sqlType:=SQL_VARBINARY;
  6950.                   cType:=SQL_C_BINARY;
  6951.                   Len:=0; //??
  6952.                   p:=Nil; //???
  6953.                   Param.FOutLen:=0; //?? current len
  6954.              End;
  6955.              ftGraphic:
  6956.              Begin
  6957.                   sqlType:=SQL_VARGRAPHIC;
  6958.                   cType:=SQL_C_BINARY;
  6959.                   Len:=0; //??
  6960.                   p:=Nil; //???
  6961.                   Param.FOutLen:=0; //?? current len
  6962.              End;
  6963.           End; //case
  6964.  
  6965.           Try
  6966.              rc:=FDBProcs.SQLBindParameter(FDBProcs.ahstmt,i+1,ptsql,ctype,sqltype,Len,0,p^,Len,Param.FOutLen);
  6967.              If rc=SQL_ERROR Then
  6968.              Begin
  6969.                  S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  6970.                  CloseStmt;
  6971.                  DoClose;
  6972.                  SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S);
  6973.              End;
  6974.  
  6975.           Except
  6976.              ON E:ESQLError Do
  6977.              Begin
  6978.                   CloseStmt;
  6979.                   ErrorBox(E.Message);
  6980.              End;
  6981.              Else
  6982.              Begin
  6983.                   CloseStmt;
  6984.                   Raise;
  6985.              End;
  6986.           End;
  6987.           If FDBProcs.ahstmt=0 Then
  6988.           Begin
  6989.                DoClose;
  6990.                exit;
  6991.           End;
  6992.      End;
  6993.     End;
  6994. Label err;
  6995. Begin
  6996.      If not Prepared Then Prepare;
  6997.  
  6998.      CloseStmt; //if previous proc returned a result set...
  6999.      FMaxRows:=0;
  7000.      If not FOpened Then DoOpen;
  7001.  
  7002.      If FOpened Then
  7003.      Begin
  7004.           FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,FDBProcs.ahstmt);
  7005.           If FDBProcs.SQLSetStmtOption(FDBProcs.ahstmt,SQL_CURSOR_TYPE,SQL_CURSOR_KEYSET_DRIVEN)=SQL_ERROR THEN
  7006.           Begin
  7007.              //S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  7008.              //ErrorBox(S);
  7009.           End;
  7010.      End
  7011.      Else exit;
  7012.  
  7013.      If FDBProcs.DBType=Native_Oracle7 Then
  7014.      Begin
  7015.          rc:=ExecSQL;
  7016.          If rc=SQL_ERROR Then goto err;
  7017.      End;
  7018.  
  7019.      //Bind Parameters
  7020.      BindParameters;
  7021.      If FDBProcs.ahstmt=0 Then
  7022.      Begin
  7023.           DoClose;
  7024.           exit;
  7025.      End;
  7026.  
  7027.      FFieldDefs.Clear;
  7028.      FCurrentRow:=-1;
  7029.      FCurrentField:=0;
  7030.  
  7031.      ReturnsResultSet:=False;
  7032.  
  7033.      EnterSQLProcessing;
  7034.      If FDBProcs.DBType<>Native_Oracle7 Then rc:=ExecSQL
  7035.      Else rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  7036.  
  7037.      If rc<>SQL_ERROR Then
  7038.      Begin
  7039.          For i:=0 To FParams.Count-1 Do
  7040.          Begin
  7041.              Param:=FParams[i];
  7042.  
  7043.              If Param.ParamType<>ptOutput Then
  7044.                If Param.ParamType<>ptInputOutput Then
  7045.                  If Param.ParamType<>ptResult Then continue;
  7046.  
  7047.              Case Param.DataType Of
  7048.                ftString:
  7049.                Begin
  7050.                     Param.AsString:=Param.FResultNTS;
  7051.                End;
  7052.                ftCurrency:
  7053.                Begin
  7054.                     Param.AsFloat:=Param.FResultExtended;
  7055.                End;
  7056.                ftInteger:
  7057.                Begin
  7058.                     Param.AsInteger:=Param.FResultLongInt;
  7059.                End;
  7060.                ftSmallInt:
  7061.                Begin
  7062.                     Param.AsSmallInt:=Param.FResultSmallInt;
  7063.                End;
  7064.                ftFloat:
  7065.                Begin
  7066.                     Param.AsFloat:=Param.FResultExtended;
  7067.                End;
  7068.                ftDate:
  7069.                Begin
  7070.                     Param.AsDate:=EncodeDate(Param.FResultDate.Year,Param.FResultDate.Month,Param.FResultDate.Day);
  7071.                End;
  7072.                ftTime:
  7073.                Begin
  7074.                     Param.AsTime:=EncodeTime(Param.FResultTime.Hour,Param.FResultTime.Minute,Param.FResultTime.Second,0);
  7075.                End;
  7076.                ftDateTime:
  7077.                Begin
  7078.                     Param.AsDateTime:=EncodeDate(Param.FResultDateTime.Year,Param.FResultDateTime.Month,Param.FResultDateTime.Day) +
  7079.                                       EncodeTime(Param.FResultDateTime.Hour,Param.FResultDateTime.Minute,Param.FResultDateTime.Second, 0);
  7080.                End;
  7081.                ftMemo:
  7082.                Begin
  7083.                End;
  7084.                ftBlob:
  7085.                Begin
  7086.                End;
  7087.                ftGraphic:
  7088.                Begin
  7089.                End;
  7090.              End; //case
  7091.          End; //for
  7092.  
  7093.          If ReturnsResultSet Then
  7094.          Begin
  7095.               {The driver determines the number of rows in the result set}
  7096.               rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  7097.               FMaxRows:=0;
  7098.               While ((rc<>SQL_NO_DATA_FOUND)And(rc<>SQL_ERROR)) Do
  7099.               Begin
  7100.                   inc(FMaxRows);
  7101.                   rc:=FDBProcs.SQLFetch(FDBProcs.ahstmt);
  7102.               End;
  7103.               FDBProcs.SQLFreeStmt(FDBProcs.ahstmt,SQL_DROP);
  7104.               FDBProcs.ahstmt:=0;
  7105.  
  7106.               {The driver recreates the result set}
  7107.               FDBProcs.SQLAllocStmt(FDBProcs.ahdbc,FDBProcs.ahstmt);
  7108.               If FDBProcs.SQLSetStmtOption(FDBProcs.ahstmt,SQL_CURSOR_TYPE,SQL_CURSOR_KEYSET_DRIVEN)=SQL_ERROR THEN
  7109.               Begin
  7110.                  //S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  7111.                  //ErrorBox(S);
  7112.               End;
  7113.               BindParameters;
  7114.               If FDBProcs.ahstmt=0 Then
  7115.               Begin
  7116.                   DoClose;
  7117.                   LeaveSQLProcessing;
  7118.                   exit;
  7119.               End;
  7120.  
  7121.               rc:=FDBProcs.SQLExecDirect(FDBProcs.ahstmt,c,SQL_NTS);
  7122.               If rc=SQL_ERROR Then goto err;
  7123.  
  7124.               Try
  7125.                  FDBProcs.SQLNumResultCols(FDBProcs.ahstmt,resultCols);
  7126.                  If resultCols=0 Then //Not A Select statement
  7127.                  Begin
  7128.                       CloseStmt;
  7129.                       SQLError(LoadNLSStr(SEmptyResultSet));
  7130.                  End
  7131.                  Else
  7132.                  Begin
  7133.                       {Store Result Columns}
  7134.                       For I := 0 To resultCols-1 Do
  7135.                       Begin
  7136.                             Size:=0;
  7137.                             FDBProcs.SQLDescribeCol(FDBProcs.ahstmt, I + 1, colName,
  7138.                               SizeOf(colName), colNameLen, colType, Size, Scale, Nil);
  7139.                             If Size>65535 Then Size:=4096;
  7140.                             S:=colName;
  7141.  
  7142.                             Case ColType Of
  7143.                                SQL_REAL:Size:=4;
  7144.                                SQL_FLOAT,SQL_DOUBLE,SQL_NUMERIC:Size:=8;
  7145.                             End; //case
  7146.  
  7147.                             FFieldDefs.Add(S, MapSQLType(colType), Size, False);
  7148.  
  7149.                             FieldDef := FFieldDefs[I];
  7150.                             FieldDef.Precision := Scale;
  7151.                       End;
  7152.  
  7153.                       FCurrentRow:=0;   {First Row}
  7154.                       FCurrentField:=0; {First field}
  7155.                  End;
  7156.  
  7157.                  Post;  //Commit All transactions Until here
  7158.                  DataChange(deDataBaseChanged);
  7159.               Except
  7160.                  ON E:ESQLError Do
  7161.                  Begin
  7162.                       CloseStmt;
  7163.                       LeaveSQLProcessing;
  7164.                       ErrorBox(E.Message);
  7165.                  End;
  7166.                  Else
  7167.                  Begin
  7168.                       CloseStmt;
  7169.                       LeaveSQLProcessing;
  7170.                       Raise;
  7171.                  End;
  7172.               End;
  7173.  
  7174.               //for result sets the statement must remain open...
  7175.          End
  7176.          Else CloseStmt;
  7177.  
  7178.          LeaveSQLProcessing;
  7179.      End
  7180.      Else
  7181.      Begin
  7182. err:
  7183.           LeaveSQLProcessing;
  7184.           Try
  7185.              S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,FDBProcs.ahstmt);
  7186.              CloseStmt;
  7187.              SQLError(LoadNLSStr(SErrorExecutingSQLStatement)+': '+S);
  7188.           Except
  7189.              ON E:ESQLError Do
  7190.              Begin
  7191.                   CloseStmt;
  7192.                   ErrorBox(E.Message);
  7193.              End;
  7194.              Else
  7195.              Begin
  7196.                   CloseStmt;
  7197.                   Raise;
  7198.              End;
  7199.           End;
  7200.      End;
  7201. End;
  7202.  
  7203. Function TStoredProc.ParamByName(Const Value:String):TParam;
  7204. Begin
  7205.      Result := FParams.ParamByName(Value);
  7206. End;
  7207.  
  7208. Procedure TStoredProc.Prepare;
  7209. Begin
  7210.      If FParams.Count=0 Then SetDefaultParams;
  7211.      Prepared:=True;
  7212. End;
  7213.  
  7214.  
  7215. Procedure TStoredProc.UnPrepare;
  7216. Begin
  7217.      Prepared:=False;
  7218. End;
  7219.  
  7220.  
  7221. Procedure TStoredProc.DoOpen;
  7222. Var rc:SQLRETURN;
  7223.     S:String;
  7224. Begin
  7225.      If Not FActive Then Exit;
  7226.  
  7227.      If Not FillDBProcs(FDBProcs) Then
  7228.      Begin
  7229.           ErrorBox(LoadNLSStr(SErrLoadingDB));
  7230.           Active:=False;
  7231.           Exit; {Error}
  7232.      End;
  7233.      FDBProcs.IsStoredProc:=True;
  7234.  
  7235.      If Not FOpened Then
  7236.      Begin
  7237.           Try
  7238.              If FBeforeOpen<>Nil Then FBeforeOpen(Self);
  7239.  
  7240.              FDBProcs.ahstmt:=0;
  7241.              FDBProcs.ahenv:=0;
  7242.              If AllocateDBEnvironment(FDBProcs)<>SQL_SUCCESS Then
  7243.              Begin
  7244.                   ErrorBox(LoadNLSStr(SErrAllocDBEnv)+'.'+
  7245.                            SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  7246.                   Active:=False;
  7247.                   Exit;
  7248.              End;
  7249.  
  7250.              {Connect To Server}
  7251.              FDBProcs.ahdbc:=0;
  7252.              If FDBProcs.SQLAllocConnect(FDBProcs.ahenv,FDBProcs.ahdbc)<>SQL_SUCCESS Then
  7253.              Begin
  7254.                   ErrorBox(LoadNLSStr(SErrAllocDBConnect)+'.'+
  7255.                             SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  7256.                   DoClose;
  7257.                   Exit;
  7258.              End;
  7259.  
  7260.              {Set autocommit OFF}
  7261.              If FDBProcs.SQLSetConnectOption(FDBProcs.ahdbc,SQL_AUTOCOMMIT,SQL_AUTOCOMMIT_OFF)<>SQL_SUCCESS Then
  7262.              Begin
  7263.                   ErrorBox(LoadNLSStr(SErrSettingDBOpts)+'.'+
  7264.                             SQLErrorText(FDBProcs,FDBProcs.ahenv,0,0));
  7265.                   DoClose;
  7266.                   Exit;
  7267.              End;
  7268.  
  7269.              {Connect}
  7270.              Try
  7271.                 If FDBProcs.uid='' Then
  7272.                 Begin
  7273.                      If FDBProcs.pwd='' Then
  7274.                        rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  7275.                                                Nil,0,Nil,0)
  7276.                      Else
  7277.                        rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  7278.                                                Nil,0,FDBProcs.pwd,SQL_NTS);
  7279.                 End
  7280.                 Else If FDBProcs.pwd='' Then
  7281.                 Begin
  7282.                      rc:=FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  7283.                                              FDBProcs.uid,SQL_NTS,Nil,0);
  7284.                 End
  7285.                 Else rc:= FDBProcs.SqlConnect(FDBProcs.ahdbc,FDBProcs.DataBase,SQL_NTS,
  7286.                                               FDBProcs.uid,SQL_NTS,FDBProcs.pwd,SQL_NTS);
  7287.                 If rc<>SQL_SUCCESS Then
  7288.                 Begin
  7289.                      S:=SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0);
  7290.                      DoClose;
  7291.                      SQLError(LoadNLSStr(SErrorDBConnecting)+' "'+DataBase+'".'+#13#10+S);
  7292.                 End;
  7293.              Except
  7294.                 ON E:ESQLError Do
  7295.                 Begin
  7296.                      ErrorBox(E.Message);
  7297.                      Exit;
  7298.                 End;
  7299.                 Else Raise;
  7300.              End;
  7301.  
  7302.              FOpened:=True;
  7303.              If FAfterOpen<>Nil Then AfterOpen(Self);
  7304.  
  7305.              If FParams.Count=0 Then SetDefaultParams;
  7306.           Except
  7307.              Raise;
  7308.           End;
  7309.      End;
  7310. End;
  7311.  
  7312.  
  7313. Procedure TStoredProc.DoClose;
  7314. Var OldOpened:Boolean;
  7315. Begin
  7316.      Try
  7317.         If FBeforeClose<>Nil Then FBeforeClose(Self);
  7318.  
  7319.         OldOpened:=FOpened;
  7320.         TDataSet.DoClose;
  7321.         FOpened:=OldOpened;
  7322.  
  7323.         If FOpened Then
  7324.         Begin
  7325.              CloseStmt;
  7326.              Post;  //Commit All transactions
  7327.         End;
  7328.  
  7329.         FActive:=False;
  7330.         FDataSetLocked:=True;
  7331.         FFieldDefs.Clear;
  7332.  
  7333.         FDataSetLocked:=False;
  7334.  
  7335.         If FDBProcs.ahdbc<>0 Then
  7336.         Begin
  7337.              If FOpened Then
  7338.                If FDBProcs.SQLDisconnect(FDBProcs.ahdbc)<>SQL_SUCCESS Then
  7339.                  ErrorBox('Disconnect error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  7340.              If FDBProcs.SQLFreeConnect(FDBProcs.ahdbc)<>SQL_SUCCESS Then
  7341.                ErrorBox('FreeConnect error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  7342.              FDBProcs.ahdbc:=0;
  7343.         End;
  7344.  
  7345.         If FDBProcs.ahenv<>0 Then
  7346.         Begin
  7347.              If FDBProcs.SQLFreeEnv(FDBProcs.ahenv)<>SQL_SUCCESS Then
  7348.                ErrorBox('FreeEnv error '+SQLErrorText(FDBProcs,FDBProcs.ahenv,FDBProcs.ahdbc,0));
  7349.              FDBProcs.ahenv:=0;
  7350.         End;
  7351.  
  7352.         FOpened:=False;
  7353.         DataChange(deDataBaseChanged);
  7354.  
  7355.         If FAfterClose<>Nil Then FAfterClose(Self);
  7356.      Except
  7357.         Raise;
  7358.      End;
  7359. End;
  7360.  
  7361.  
  7362. Procedure TStoredProc.Loaded;
  7363. Var OldOpen,OldActive:Boolean;
  7364. Begin
  7365.      Inherited Loaded;
  7366.  
  7367.      OldOpen:=FOpened;
  7368.      OldActive:=FActive;
  7369.      FActive:=True;
  7370.      DoOpen;
  7371.      If not OldOpen Then DoClose;
  7372.      FActive:=OldActive;
  7373. End;
  7374.  
  7375.  
  7376. Procedure TStoredProc.Delete;
  7377. Begin
  7378. End;
  7379.  
  7380.  
  7381. Procedure TStoredProc.Insert;
  7382. Begin
  7383. End;
  7384.  
  7385.  
  7386. Procedure TStoredProc.InsertRecord(Const values:Array Of Const);
  7387. Begin
  7388.      Try
  7389.         FDataChangeLock:=True;
  7390.         Insert;
  7391.      Finally
  7392.         FDataChangeLock:=False;
  7393.      End;
  7394.      SetFields(values);
  7395. End;
  7396.  
  7397.  
  7398. Function TStoredProc.UpdateFieldSelect(field:TField):Boolean;
  7399. Begin
  7400.      Result:=False;
  7401. End;
  7402.  
  7403.  
  7404.  
  7405. Begin
  7406. End.
  7407.  
  7408.