ezaccess2000.pas

很管用的GIS控件

unit EzAccess2000;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}

{ This unit will override a low level access database by using ADOX for Access2000
  for later using as the attached Db file for every layer.
  For using this unit:
    - just add this unit to your project
    - Also, be sure that in unit ezimpl.pas, all the defines for using an attached
      table for every layer, are turned off. Currently we have the following:

      //$DEFINE NATIVEDB
      //$DEFINE DATASET_PROVIDER
      //$DEFINE HALCYONDB
      //$DEFINE BORLAND_BDE
      //$DEFINE DBISAMDB

    All must be turned off as is shown above.
  }

// This code was tested with ADO/ADOX 2.6.


// ADODB_TLB can be obtained by importing the ADO Type Library:
//
// Select Project/Import Type Library...
// Select 'Microsoft ActiveX Data Objects 2.6 Library'
// or Add C:\Program Files\Common Files\System\ADO\msado15.dll
//
// ADOX_TLB can be obtained by importing the ADOX Type Library:
//
// Select Project/Import Type Library...
// Select 'Microsoft ADO Ext. 2.6 for DDL and Security'
// or Add C:\Program Files\Common Files\System\ado\msadox.dll
//
// The Generate Code Wrapper option is not needed.
//
// ADOX is documented in ado260.chm, which is available as a separate download
// from www.microsoft.com/data, or as part of the Platform SDK or the MSDN
// library, specifically:
//
// Data Access Services/
// Microsoft Data Access Components (MDAC) SDK/
// Microsoft ActiveX Data Objects/
// Microsoft ADOX Programmer's Reference
//
// The OLE DB provider properties (as distinct from ADOX object properties)
// are documented in:
//
// Data Access Services/
// Microsoft Data Access Components (MDAC) SDK/
// Microsoft Data Access Technical Articles/
// ActiveX Data Objects (ADO) Technical Articles/
// Migrating from DAO to ADO/
// Appendix B: Microsoft Jet 4.0 OLE DB Properties Reference.


interface

uses
  SysUtils, Windows, Classes, ezbase, ezbasegis, Db, ADODB, ADOX_TLB, ADODB_TLB
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

const
  { the string used for the connection. The database must not be defined because
   in every map new, map open the actual database will be defined there. }
  ACCESS_CONNECTION_STRING = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Jet OLEDB:Engine Type=5' ;

Type

  TEzADOXTable = Class( TEzBaseTable )
  Private
    FADOTable: TADOTable;
  Protected
    Function GetActive: boolean; Override;
    Procedure SetActive( Value: boolean ); Override;
    Function GetRecNo: Integer; Override;
    Procedure SetRecNo( Value: Integer ); Override;
  Public
    Constructor Create( Gis: TEzBaseGis; Const FName: String;
      ReadWrite, Shared: boolean ); Override;
    Destructor Destroy; Override;
    Procedure Append( NewRecno: Integer ); Override;
    Function BOF: Boolean; Override;
    Function EOF: Boolean; Override;
    Function DateGet( Const FieldName: String ): TDateTime; Override;
    Function DateGetN( FieldNo: integer ): TDateTime; Override;
    Function Deleted: Boolean; Override;
    Function Field( FieldNo: integer ): String; Override;
    Function FieldCount: integer; Override;
    Function FieldDec( FieldNo: integer ): integer; Override;
    Function FieldGet( Const FieldName: String ): String; Override;
    Function FieldGetN( FieldNo: integer ): String; Override;
    Function FieldLen( FieldNo: integer ): integer; Override;
    Function FieldNo( Const FieldName: String ): integer; Override;
    Function FieldType( FieldNo: integer ): char; Override;
    Function Find( Const ss: String; IsExact, IsNear: boolean ): boolean; Override;
    Function FloatGet( Const Fieldname: String ): Double; Override;
    Function FloatGetN( FieldNo: Integer ): Double; Override;
    Function IndexCount: integer; Override;
    Function IndexAscending( Value: integer ): boolean; Override;
    Function Index( Const INames, Tag: String ): integer; Override;
    Function IndexCurrent: String; Override;
    Function IndexUnique( Value: integer ): boolean; Override;
    Function IndexExpression( Value: integer ): String; Override;
    Function IndexTagName( Value: integer ): String; Override;
    Function IndexFilter( Value: integer ): String; Override;
    Function IntegerGet( Const FieldName: String ): Integer; Override;
    Function IntegerGetN( FieldNo: integer ): Integer; Override;
    Function LogicGet( Const FieldName: String ): Boolean; Override;
    Function LogicGetN( FieldNo: integer ): Boolean; Override;
    Procedure MemoSave( Const FieldName: String; Stream: Classes.TStream ); Override;
    Procedure MemoSaveN( FieldNo: integer; Stream: Classes.TStream ); Override;
    Function MemoSize( Const FieldName: String ): Integer; Override;
    Function MemoSizeN( FieldNo: integer ): Integer; Override;
    Function RecordCount: Integer; Override;
    Function StringGet( Const FieldName: String ): String; Override;
    Function StringGetN( FieldNo: integer ): String; Override;
    //Procedure CopyStructure( Const FileName, APassword: String ); Override;
    //Procedure CopyTo( Const FileName, APassword: String ); Override;
    Procedure DatePut( Const FieldName: String; value: TDateTime ); Override;
    Procedure DatePutN( FieldNo: integer; value: TDateTime ); Override;
    Procedure Delete; Override;
    Procedure Edit; Override;
    Procedure FieldPut( Const FieldName, Value: String ); Override;
    Procedure FieldPutN( FieldNo: integer; Const Value: String ); Override;
    Procedure First; Override;
    Procedure FloatPut( Const FieldName: String; Const Value: Double ); Override;
    Procedure FloatPutN( FieldNo: integer; Const Value: Double ); Override;
    Procedure FlushDB; Override;
    Procedure Go( n: Integer ); Override;
    Procedure IndexOn( Const IName, tag, keyexp, forexp: String;
      uniq: TEzIndexUnique; ascnd: TEzSortStatus ); Override;
    Procedure IntegerPut( Const Fieldname: String; Value: Integer ); Override;
    Procedure IntegerPutN( FieldNo: integer; Value: Integer ); Override;
    Procedure Last; Override;
    Procedure LogicPut( Const fieldname: String; value: boolean ); Override;
    Procedure LogicPutN( fieldno: integer; value: boolean ); Override;
    Procedure MemoLoad( Const fieldname: String; Stream: Classes.TStream ); Override;
    Procedure MemoLoadN( fieldno: integer; Stream: Classes.TStream ); Override;
    Procedure Next; Override;
    Procedure Pack; Override;
    Procedure Post; Override;
    Procedure Prior; Override;
    Procedure Recall; Override;
    Procedure Refresh; Override;
    Procedure Reindex; Override;
    Procedure SetTagTo( Const TName: String ); Override;
    Procedure SetUseDeleted( tf: boolean ); Override;
    Procedure StringPut( Const fieldname, value: String ); Override;
    Procedure StringPutN( fieldno: integer; Const value: String ); Override;
    Procedure Zap; Override;
    Function DBCreateTable( Const fname: String;
      AFieldList: TStringList ): boolean; Override;
    function DBTableExists( const TableName: string ): Boolean; Override;
    Function DBDropTable( const TableName: string): Boolean; Override;
    Function DBDropIndex( const TableName: string): Boolean; Override;
    Function DBRenameTable( const Source, Target: string): Boolean; Override;
  End;

Var
  { This object is used for all the connections. From your main form
    you must define the connection  parameters for this variable.
    This variable is instantiated on the initialization section of this unit }
  ADOConnection: TADOConnection;

implementation

uses
  EzSystem, EzConsts ;

Function TEzADOXTable.DBRenameTable( const Source, Target: string): Boolean;
begin
  { don't know for now how to rename a table }
end;

Function TEzADOXTable.DBDropIndex( const TableName: string): Boolean;
begin
  { don't know for now how to drop an index. Please us MS Access }
end;

Function TEzADOXTable.DBDropTable( const TableName: string): Boolean;
begin
  { don't know for now how to drop a table. Use MS Access }
end;

function TEzADOXTable.DBTableExists( const TableName: string ): Boolean;
var
  AccessMdb, DataSource: string ;
  Catalog : _Catalog ;
  Connection : _Connection ;
  I: Integer;
  TblNam: string;
begin
  Result:= false;
  AccessMdb:= ChangeFileExt( Gis.FileName, '.mdb' );
  If Not FileExists( AccessMdb ) then exit;

  Catalog := CoCatalog.Create;

  DataSource := Format( ACCESS_CONNECTION_STRING, [AccessMdb] );

  Connection := CoConnection.Create;

  with Connection do
  begin
    ConnectionString := DataSource;
    // Specify exclusive access because we intend modifying the database's
    // structure.  The default is adModeUnknown.
    Mode := adModeShareExclusive;
    Open('', '', '', Unassigned);
  end;
  // Link the Catalog object to the open connection
  Catalog._Set_ActiveConnection(Connection);

  Try
    TblNam:= ChangeFileExt( ExtractFileName( TableName ), '' );
    For I:= 0 to Catalog.Tables.Count-1 do
      If AnsiCompareText( Catalog.Tables[I].Name, TblNam ) = 0 then
      begin
        Result:= true;
        Break;
      end;
  Finally
    Catalog.Set_ActiveConnection(Unassigned);
  End;

  Catalog := Nil;
  Connection := Nil;

end;

Function TEzADOXTable.DBCreateTable( Const fname: String; AFieldList: TStringList ): boolean;
Var
  s: String;
  v: boolean;
  i: integer;
  p: integer;
  fs: String;
  ft: String[1];
  fl: integer;
  fd: integer;
  DataSource: string;
  Catalog: _Catalog;
  Table: _Table;
  Index1, Index2 : _Index;
  Column, Column1, Column2: _Column;
  Connection: _Connection;
  AccessMdb: string;

  Procedure LoadField;
  Begin
    v := true;
    p := Ansipos( ';', s );
    fs := '';
    If p > 0 Then
    Begin
      fs := System.Copy( s, 1, pred( p ) );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    ft := ' ';
    If p = 2 Then
    Begin
      ft := System.Copy( s, 1, 1 );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    fl := 0;
    If p > 0 Then
    Begin
      Try
        fl := StrToInt( System.Copy( s, 1, pred( p ) ) );
        System.Delete( s, 1, p );
      Except
        On Exception Do
          v := false;
      End;
    End
    Else
      v := false;

    fd := 0;
    Try
      fd := StrToInt( System.Copy( s, 1, 3 ) );
    Except
      On Exception Do
        v := false;
    End;
  End;

Begin
  AccessMdb:= ChangeFileExt( Gis.FileName, '.mdb' );

  // Create a catalog (database) object using the provided COM object
  // creation method - no need for wrappers and no need for garbage
  // collection.  All COM objects created will be automatically destroyed
  // when they go out of scope. (The OP compiler adds code to decrement
  // each object's reference count when they go out of scope.  Since creating
  // the object in OP automatically increments its reference count to 1, this
  // ensures that COM will destroy the object because its reference count
  // then equals 0.  Note that the scope is defined by the object's
  // declaration procedure, which is not necessarily where they are created).
  Catalog := CoCatalog.Create;

  // Set the connection string.
  // Note that properties specified in the connection string, such as
  // Jet OLEDB:Engine Type or Jet OLEDB:Encrypt Database are subsequently
  // used in the Catalog.Create method, but not all connection properties are
  // supported.  See the Microsoft Jet 4.0 OLE DB Properties Reference for
  // further details.
  // BTW, Jet Engine Type 5 = Access 2000; Type 4 = Access 97
  DataSource := Format( ACCESS_CONNECTION_STRING, [AccessMdb] );

  If not FileExists( AccessMdb ) then
  begin

    // Create a new Access database
    Catalog.Create( DataSource );

    Catalog.Set_ActiveConnection(Unassigned);

    Catalog := nil;

  end;

  Connection := CoConnection.Create;

  with Connection do
  begin
    ConnectionString := DataSource;
    // Specify exclusive access because we intend modifying the database's
    // structure.  The default is adModeUnknown.
    Mode := adModeShareExclusive;
    Open('', '', '', Unassigned);
  end;
  // Recreate the Catalog object
  Catalog := CoCatalog.Create;
  // Link the Catalog object to the open connection
  Catalog._Set_ActiveConnection(Connection);

  { now create the table }
  Table := CoTable.Create;
  with Table do
  begin
    ParentCatalog := Catalog;
    Name := ExtractFilePath( fname );
  end;

  { create the columns }
  // Create the column objects for the master table
  Column1 := CoColumn.Create;
  with Column1 do
    begin
      ParentCatalog := Catalog;
      Name := 'UID';
      Type_ := adInteger;
      // A bug in ADO 2.5 means that the Default property value will not be
      // accepted and no error will be given. This bug is not in 2.1 or 2.6.
      Properties['Default'].Value := 0;

      // Expression to be evaluated on a column to validate its value before
      // allowing it to be set. This operates in a fashion similar to SQL-92
      // CHECK clauses.
      Properties['Jet OLEDB:Column Validation Rule'].Value := '>= 1';
      // Error string to display when the validation rule specified in
      // Jet OLEDB:Column Validation Rule is not met.
      Properties['Jet OLEDB:Column Validation Text'].Value :=
        'Please enter a number greater than or equal to 1';

      // Specify a human-readable string description of the column.
      //
      // Note that you must use the expanded syntax in order to write to
      // the Properties collection.  If you try to use an abbreviated syntax
      // based on the Properties collection default (Value), such as:
      //
      //   Properties['x'] := false
      //
      // you will get a compiler error about trying to write to a read-only
      // property.
      Properties['Description'].Value :=