ezibgis.pas

很管用的GIS控件

    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: TStream ); Override;
    Procedure MemoLoadN( fieldno: integer; Stream: 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 DBTableExists( const TableName: string ): Boolean; Override;

    Property Layer: TEzIBLayer
      read {$IFDEF BCB} GetLayer {$ELSE} FLayer {$ENDIF}
      write {$IFDEF BCB} SetLayer {$ELSE} FLayer {$ENDIF}; (*_*)
  End;

Implementation

Uses
  Inifiles, ezsystem, ezconsts, ezentities, ezctrls, ezcadctrls,
  ezbasicctrls, ezimpl, IBHeader
{$IFDEF COMPRESSED_ENTITY}
  , EzZLibUtil
{$ENDIF}
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

Resourcestring

  SEz_GisIBVersion = 'TEzIBGis Version 1.95 (Ene, 2003)';

  SQL_GETLAYERLIST =
    'SELECT rdb$relation_name FROM rdb$relations WHERE UPPER( rdb$relation_name) LIKE ''LAYINFO%''';

  SQL_CHECKTABLEEXISTS =
    'SELECT rdb$relation_name FROM rdb$relations WHERE UPPER(rdb$relation_name) = ''%s''';

  SQL_CHECKPROCEXISTS =
    'SELECT rdb$procedure_name FROM rdb$procedures WHERE UPPER(rdb$procedure_name) = ''%s''';

  SQL_CHECKGENERATOREXISTS =
    'SELECT rdb$generator_name FROM rdb$generators WHERE UPPER(rdb$generator_name) = ''%s''';

  //SQL_CHECKTRIGGEREXISTS =
  //  'SELECT rdb$trigger_name FROM rdb$triggers WHERE UPPER(rdb$trigger_name) = ''%s''';

  SQL_CHECKUDFEXISTS =
    'SELECT rdb$function_name FROM rdb$functions WHERE UPPER(rdb$function_name) = ''%s''';

  SQL_DOMAIN1 = 'CREATE DOMAIN dmnBOOLEAN AS CHAR(1) CHECK ( VALUE IN (''Y'', ''N'') ) NOT NULL ;';

  SQL_DECLAREUDF1 =
  'DECLARE EXTERNAL FUNCTION ezsearch_init ' + crlf +
	'  INTEGER, INTEGER, INTEGER, INTEGER ' + crlf +
	'  RETURNS INTEGER BY VALUE ' + crlf +
	'  ENTRY_POINT ''IB_ezsearch_init'' MODULE_NAME ''ib_ezudfs''; ' ;

  SQL_DECLAREUDF2 =
  'DECLARE EXTERNAL FUNCTION ezsearch_find ' + crlf +
	'  INTEGER, INTEGER, INTEGER, CSTRING(10), CSTRING(3010), INTEGER ' + crlf +
	'  RETURNS INTEGER BY VALUE ' + crlf +
	'  ENTRY_POINT ''IB_ezsearch_find'' MODULE_NAME ''ib_ezudfs''; ' ;

  SQL_DECLAREUDF3 =
  'DECLARE EXTERNAL FUNCTION ezsearch_first ' + crlf +
	'  INTEGER ' + crlf +
	'  RETURNS INTEGER BY VALUE ' + crlf +
	'  ENTRY_POINT ''IB_ezsearch_first'' MODULE_NAME ''ib_ezudfs''; ' ;

  SQL_DECLAREUDF4 =
  'DECLARE EXTERNAL FUNCTION ezsearch_next ' + crlf +
	'  INTEGER ' + crlf +
	'  RETURNS INTEGER BY VALUE ' + crlf +
	'  ENTRY_POINT ''IB_ezsearch_next'' MODULE_NAME ''ib_ezudfs''; ' ;

  SQL_DECLAREUDF5 =
  'DECLARE EXTERNAL FUNCTION ezsearch_finish ' + crlf +
	'  INTEGER ' + crlf +
	'  RETURNS INTEGER BY VALUE ' + crlf +
	'  ENTRY_POINT ''IB_ezsearch_finish'' MODULE_NAME ''ib_ezudfs''; ' ;

  SQL_CREATELAYINFO1 =
    'CREATE TABLE LAYINFO_%s (' +
    'VERSION int DEFAULT 141,' +
    'LASTUID int DEFAULT 0,' +
    'VISIBLE dmnBOOLEAN DEFAULT ''Y'' ,' +   //CHECK (VALUE = UPPER(VALUE))
    'SELECTABLE dmnBOOLEAN DEFAULT ''Y'' ,' +    //CHECK (VALUE = UPPER(VALUE))
    'CANCELEVENTS dmnBOOLEAN DEFAULT ''N'' ,' +    // CHECK (VALUE = UPPER(VALUE))
    'TEXT_HAS_SHADOW dmnBOOLEAN DEFAULT ''N'' ,';  //CHECK (VALUE = UPPER(VALUE))

  SQL_CREATELAYINFO2 =
    'EXTENSION_x1 DOUBLE PRECISION DEFAULT 1000000000,' +
    'EXTENSION_y1 DOUBLE PRECISION DEFAULT 1000000000,' +
    'EXTENSION_x2 DOUBLE PRECISION DEFAULT -1000000000,' +
    'EXTENSION_y2 DOUBLE PRECISION DEFAULT -1000000000,';

  SQL_CREATELAYINFO3 =
    'COORDSUNITS int DEFAULT 0,' +
    'COORDSYSTEM int DEFAULT 0,';

  SQL_CREATELAYINFO4 =
    'OVERLAPPED_TEXT_ACTION smallint DEFAULT 0,' +
    'OVERLAPPED_TEXT_COLOR int DEFAULT 0,' +
    'TEXT_FIXED_SIZE smallint DEFAULT 0,';

  SQL_CREATELAYINFO5 = // r-tree information also goes here
    'ROOTNODE int DEFAULT 0,' +
    'DEPTH	int DEFAULT 0,' +
    'TREETYPE int DEFAULT 0,' +
    'MULTIPLIER integer DEFAULT 1,' +
    'BUCKETSIZE int DEFAULT 50,' +
    'LOWERBOUND int DEFAULT 20)';

  SQL_CREATEENT =
    'CREATE TABLE ENT_%s (' +
    'UID int NOT NULL PRIMARY KEY,' +
    'DELETED dmnBOOLEAN DEFAULT ''N'' ,'+    //CHECK (VALUE = UPPER(VALUE))
    'XMIN DOUBLE PRECISION DEFAULT 0,' +
    'YMIN DOUBLE PRECISION DEFAULT 0,' +
    'XMAX DOUBLE PRECISION DEFAULT 0,' +
    'YMAX DOUBLE PRECISION DEFAULT 0,' +
    'SHAPETYPE smallint DEFAULT 0,';

  SQL_CREATERTX =
    'CREATE TABLE RTX_%s (' +
    'PAGEID int NOT NULL PRIMARY KEY,' +
    'PARENT int DEFAULT 0,' +
    'FULLENTRIES int DEFAULT 0,' +
    'LEAF dmnBOOLEAN DEFAULT ''Y'' ,' +    //CHECK (VALUE = UPPER(VALUE))
    'ENTRIES char(3000) )';

  SQL_UPDATENODE = 'UPDATE rtx_%s SET parent = %d, fullentries = %d, leaf = ''%s'', ' +
    'entries = ''%s'' WHERE pageid = %d';

  // what a disappointment !!!: not possible to pass BLOBs to stored procedures in InterBase
  SP_ADDENTITY = 'CREATE PROCEDURE addentity_xxx ( ' + crlf +
    '  v_xmin DOUBLE PRECISION, v_ymin DOUBLE PRECISION, ' + crlf +
    '  v_xmax DOUBLE PRECISION, v_ymax DOUBLE PRECISION, v_shapetype int)' + crlf +
    '  RETURNS ( newuid int )' + crlf +
    'AS' + crlf +
    'BEGIN' + crlf +
    '  newuid = gen_id( gen_ent_xxx, 1 ) ;' + crlf +
    '  INSERT INTO ent_xxx ( uid, deleted, xmin, ymin, xmax, ymax, shapetype)' + crlf +
    '    VALUES ( :newuid, ''N'', :v_xmin, :v_ymin, :v_xmax, :v_ymax, :v_shapetype );' + crlf +
    '  SUSPEND;' + crlf +
    'END';

  SP_ADDNODE = 'CREATE PROCEDURE addnode_xxx (' + crlf +
    '  v_parent INT, v_fullentries INT, v_leaf CHAR(1), v_entries char(3000) ) ' + crlf +
    '  RETURNS ( oid INT )' + crlf +
    'AS' + crlf +
    'BEGIN' + crlf +
    '  oid = gen_id( gen_rtx_xxx, 1 ) ;' + crlf +
    '  INSERT INTO rtx_xxx (pageid, parent, fullentries, leaf, entries)' + crlf +
    '    VALUES (:oid, :v_parent, :v_fullentries, :v_leaf, :v_entries ) ;' + crlf +
    '  SUSPEND;' + crlf +
    'END' ;

  SP_SEARCH1 =
    'create procedure search_xxx( x1 int, y1 int, x2 int, y2 int )' + crlf +
    '  returns ( uid int )' + crlf +
    'as' + crlf +
    '  declare variable v_leaf char(1) ;' + crlf +
    '  declare variable v_entries char(3000) ;' + crlf +
    '  declare variable v_fullentries int ;' + crlf +
    '  declare variable v_pid int ;' + crlf +
    '  declare variable runid int;' + crlf +
    '  declare variable zone int ;' + crlf +
    '  declare variable temp varchar(1) ;' + crlf +
    'begin' + crlf +
    '  select rootnode from layinfo_xxx into :v_pid ;' + crlf +
    '' + crlf +
    '  runid = ezsearch_init ( x1, y1, x2, y2 );' + crlf +
    '' + crlf +
    '  zone = 0;   /* zone to reentry */' + crlf +
    '  while (v_pid <> 0) do' + crlf +
    '  begin' + crlf +
    '' + crlf ;
  SP_SEARCH2 =
    '    SELECT leaf, fullentries, entries FROM rtx_xxx WHERE pageid = :v_pid' + crlf +
    '      into :v_leaf, :v_fullentries, :v_entries ;' + crlf +
    '' + crlf +
    '    temp = v_leaf;' + crlf +
    '    v_pid = ezsearch_find( runid, zone, v_pid, temp, v_entries, v_fullentries );' + crlf +
    '' + crlf +
    '    if (v_pid <> 0) then' + crlf +
    '    begin' + crlf +
    '      if (v_pid < 0) then' + crlf +
    '      begin' + crlf +
    '        v_pid = -v_pid;' + crlf +
    '        zone = 1;' + crlf +
    '      end else' + crlf +
    '      begin' + crlf +
    '        zone = 0;' + crlf +
    '      end' + crlf +
    '    end' + crlf +
    '  end' + crlf +
    '' + crlf +
    '  /* retrieve the results */' + crlf +
    '  uid = ezsearch_first ( runid );' + crlf +
    '  while (uid <> 0) do' + crlf +
    '  begin' + crlf +
    '    suspend;' + crlf +
    '    uid = ezsearch_next( runid );' + crlf +
    '  end' + crlf +
    '' + crlf +
    '  runid = ezsearch_finish ( runid );' + crlf +
    '' + crlf +
    'end' ;

  SQL_CREATEMAPHEADER1 =
    'CREATE TABLE MAP_HEADER (' +
    '  VERSION int DEFAULT 141,' +
    '  EXTENSION_x1 DOUBLE PRECISION DEFAULT 1.0E100,' +
    '  EXTENSION_y1 DOUBLE PRECISION DEFAULT 1.0E100,' +
    '  EXTENSION_x2 DOUBLE PRECISION DEFAULT -1.0E100,' +
    '  EXTENSION_Y2 DOUBLE PRECISION DEFAULT -1.0E100,' +
    '  CURRENTLAYER varchar(60) DEFAULT '''',' +
    '  AERIALVIEWLAYER varchar(60) DEFAULT '''',' +
    '  LASTVIEW_x1 DOUBLE PRECISION DEFAULT 0,' +
    '  LASTVIEW_y1 DOUBLE PRECISION DEFAULT 0,' +
    '  LASTVIEW_x2 DOUBLE PRECISION DEFAULT 100,' +
    '  LASTVIEW_y2 DOUBLE PRECISION DEFAULT 100,' +
    '  COORDSUNITS int DEFAULT 0,' +
    '  COORDSYSTEM int DEFAULT 0,' ;
  SQL_CREATEMAPHEADER2 =
    '  ISAREACLIPPED dmnBOOLEAN DEFAULT ''N'' ,' +  //CHECK (VALUE = UPPER(VALUE))
    '  AREACLIPPED_x1 DOUBLE PRECISION DEFAULT 0,' +
    '  AREACLIPPED_y1 DOUBLE PRECISION DEFAULT 0,' +
    '  AREACLIPPED_x2 DOUBLE PRECISION DEFAULT 0,' +
    '  AREACLIPPED_y2 DOUBLE PRECISION DEFAULT 0,' +
    '  CLIPAREAKIND int DEFAULT 0,' +
    '  POLYCLIPAREA BLOB SUB_TYPE 0 SEGMENT SIZE 1024,' +
    '  PROJ_PARAMS BLOB SUB_TYPE 0 SEGMENT SIZE 120,' +
    '  GUIDELINES BLOB SUB_TYPE 0 SEGMENT SIZE 1024,' +
    '  SYMBOLS BLOB SUB_TYPE 0 SEGMENT SIZE 1024,' +
    '  LAYERS BLOB SUB_TYPE 1 SEGMENT SIZE 120 )';

  STableNotFound = 'Table %s was not found';


  {------------------------------------------------------------------------------}
  {                  Trial Version stuff                                         }
  {------------------------------------------------------------------------------}

{$IFDEF IBTRIAL_VERSION}
Const
  MAX_HOURS = 50;

Resourcestring
  SHiddenFile = 'IBHLP.DLL';
  STimeExpired = 'Demo time of TEzIBGis Component has expired !';
  SDemoVersion =
    'You are using a demonstration version of TEzIBGis Component' + CrLf +
    'This message is only displayed on the demo version' + CrLf +
    'of this software. To register, contact us at:' + CrLf +
    'http://www.ezgis.com' + CrLf;

Type
  TSecurityFileRec = Record
    MagicNumber: LongInt;
    Seconds: DWORD;
    Runs: DWORD;
    LastCheck: DWORD;
  End;

Const
  MAGIC_NUMBER = DWORD( 040508 ); {08=LA, 05=K, 04=KJ}

Var
  IBGisInstances: Integer;
  IBSecurityFile: String; { Security File }

Function BuildSecurityFile: boolean;
Var
  IO: TFileStream;
  SecFileRec: TSecurityFileRec;
  I: integer;
  R: TDateTime;
Begin
  IO := TFileStream.Create( IBSecurityFile, fmCreate );
  Try
    FillChar( SecFileRec, sizEof( SecFileRec ), 0 );
    SecFileRec.MagicNumber := MAGIC_NUMBER;
    IO.Write( SecFileRec, sizEof( SecFileRec ) );
    { write random data }
    For I := 1 To 1500 Do
    Begin
      R := Random;
      IO.Write( R, sizEof( double ) );
    End;
    result := true;
  Finally
    IO.free;
  End;
End;

Var
  TimeStart: DWORD;

Function SecurityStartProgram: boolean;
Var
  IO: TFileStream;
  SecFileRec: TSecurityFileRec;
Begin
  result := false;
  If Not FileExists( IBSecurityFile ) Then
    Exit;
  IO := TFileStream.Create( IBSecurityFile, fmOpenRead Or fmShareDenyNone );
  Try
    IO.Read( SecFileRec, sizEof( SecFileRec ) );
    If SecFileRec.MagicNumber <> MAGIC_NUMBER Then
      exit;
    TimeStart := GetTickCount;
    result := true;
  Finally
    IO.Free;
  End;
End;

Function SecurityEndProgram: boolean;
Var
  IO: TFileStream;
  SecFileRec: TSecurityFileRec;
  TimeEnd: DWORD;
  Secsused: DWORD;
Begin
  Result := false;
  If Not FileExists( IBSecurityFile ) Then Exit;
  IO := TFileStream.Create( IBSecurityFile, fmOpenReadWrite Or fmShareDenyNone );
  Try
    IO.Read( SecFileRec, sizEof( SecFileRec ) );
    If SecFileRec.MagicNumber <> MAGIC_NUMBER Then Exit;
    TimeEnd := GetTickCount;
    SecsUsed := ( TimeEnd - TimeStart ) Div 1000;
    With SecFileRec Do
    Begin
      Inc( Seconds, SecsUsed );
      Inc( Runs );
    End;
    IO.Seek( 0, 0 );
    IO.Write( SecFileRec, sizEof( SecFileRec ) );
    result := true;
  Finally
    IO.free;
  End;
End;

Procedure SecurityDemoTimeUsed( Var Seconds, LastCheck, Runs: DWORD );
Var
  IO: TFileStream;
  SecFileRec: TSecurityFileRec;
Begin
  If Not FileExists( IBSecurityFile ) Then Exit;
  IO := TFileStream.Create( IBSecurityFile, fmOpenRead Or fmShareDenyNone );
  Try
    IO.Read( SecFileRec, sizEof( SecFileRec ) );
    If SecFileRec.MagicNumber <> MAGIC_NUMBER Then Exit;
    Seconds := SecFileRec.Seconds;
    Runs := SecFileRec.Runs;
    LastCheck := SecFileRec.LastCheck;
  Finally
    IO.Free;
  End;
End;

Function SecurityCheckIfValid( ShowWarning: Boolean ): Boolean;
Var
  Buffer: PChar;
  SystemDir: String;
  Runs, HoursUsed, SecondsUsed, LastCheck: DWORD;
  Stream: TFileStream;
  SecFileRec: TSecurityFileRec;
Begin
  Result := false;
  Buffer := StrAlloc( 255 );
  Try
    GetSystemDirectory( Buffer, 255 );
    SystemDir := AddSlash( StrPas( Buffer ) );
  Finally
    StrDispose( Buffer );
  End;
  IBSecurityFile := SystemDir + SHiddenFile;

  If Not FileExists( IBSecurityFile ) And Not BuildSecurityFile Then Exit;

  SecurityDemoTimeUsed( SecondsUsed, LastCheck, Runs );
  HoursUsed := ( SecondsUsed Div 3600 );
  If ( HoursUsed >= MAX_HOURS ) And ShowWarning Then
  Begin
    Application.MessageBox( pchar( STimeExpired ),
      pchar( smsgwarning ),
      MB_OK Or MB_ICONWARNING );