ezibgis.pas

很管用的GIS控件

    Exit;
  End;
  { show demo version window }
  If ShowWarning Then
  Begin
    If ( SecondsUsed - LastCheck ) >= ( 10 * 60 ) Then // check every n minutes
    Begin
      Application.MessageBox( PChar( Format( SDemoVersion, [MAX_HOURS - HoursUsed] ) ),
        PChar( smsgwarning ), MB_OK Or MB_ICONWARNING );

      Stream := TFileStream.create( IBSecurityFile, fmOpenReadWrite Or fmShareDenyNone );
      Try
        Stream.Read( SecFileRec, sizEof( SecFileRec ) );
        SecFileRec.LastCheck := SecondsUsed;
        Stream.Seek( 0, 0 );
        Stream.Write( SecFileRec, sizEof( SecFileRec ) );
      Finally
        Stream.Free;
      End;
    End;
  End;
  { mark the start of use of this software }
  If SecurityStartProgram = false Then Exit;
  Result := true;
End;

{$ENDIF}



{------------------------------------------------------------------------------}
{                  Helper procedures                                           }
{------------------------------------------------------------------------------}


Procedure IBStartTrans( IBSQL: TIBSQL );
Begin
  If ( IBSQL.Database.Connected ) And ( IBSQL.Transaction.InTransaction = False ) Then
    IBSQL.Transaction.StartTransaction;
End;

Procedure IBRollbackTrans( IBSQL: TIBSQL );
Begin
  If ( IBSQL.Database.Connected ) And ( IBSQL.Transaction.InTransaction = True ) Then
    IBSQL.Transaction.RollBack;
End;

Procedure IBCommitTrans( IBSQL: TIBSQL );
Begin
  If ( IBSQL.Database.Connected ) And ( IBSQL.Transaction.InTransaction = True ) Then
  begin
    try
      IBSQL.Transaction.Commit;
    except
      IBRollbackTrans( IBSQL );
      raise;
    end;
  end;
End;

Function TableExists( Const TableName: String; IBSQL: TIBSQL ): Boolean;
Begin
  With IBSQL Do
  Begin
    Close;
    SQL.Text := Format( SQL_CHECKTABLEEXISTS, [UpperCase(TableName)] );
    IBStartTrans( IBSQL );
    ExecQuery;
    Result := Not Eof;
    IBCommitTrans( IBSQL );
    Close;
  End;
End;

Function StoredProcExists( Const StoredProcName: String; IBSQL: TIBSQL ): Boolean;
Begin
  With IBSQL Do
  Begin
    Close;
    SQL.Text := Format( SQL_CHECKPROCEXISTS, [UpperCase(StoredProcName)] );
    IBStartTrans( IBSQL );
    ExecQuery;
    Result := Not Eof;
    IBCommitTrans( IBSQL );
    Close;
  End;
End;

Function GeneratorExists( Const GeneratorName: String; IBSQL: TIBSQL ): Boolean;
Begin
  With IBSQL Do
  Begin
    Close;
    SQL.Text := Format( SQL_CHECKGENERATOREXISTS, [UpperCase(GeneratorName)] );
    IBStartTrans( IBSQL );
    ExecQuery;
    Result := Not Eof;
    IBCommitTrans( IBSQL );
    Close;
  End;
End;

{Function TriggerExists( Const TriggerName: String; IBSQL: TIBSQL ): Boolean;
Begin
  With IBSQL Do
  Begin
    Close;
    SQL.Text := Format( SQL_CHECKTRIGGEREXISTS, [UpperCase(TriggerName)] );
    IBStartTrans( IBSQL );
    ExecQuery;
    Result := Not Eof;
    IBCommitTrans( IBSQL );
    Close;
  End;
End;}

Function InterbaseUDFExists( Const UdfName: String; IBSQL: TIBSQL ): Boolean;
Begin
  With IBSQL Do
  Begin
    Close;
    SQL.Text := Format( SQL_CHECKUDFEXISTS, [UpperCase(UdfName)] );
    IBStartTrans( IBSQL );
    ExecQuery;
    Result := Not Eof;
    IBCommitTrans( IBSQL );
    Close;
  End;
End;

Procedure CreateLayerElements( Const LayerName: String; IBSQL: TIBSQL );
Var
  tbl: String;

  Procedure CreateElement(const Ele: string);
  Begin
    With IBSQL Do
    Begin
      Close;
      ParamCheck:=false;
      SQL.Text:= Ele;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;
  End;

Begin

  // GENERATORS
  If Not GeneratorExists( 'gen_ent_' + LayerName, IBSQL ) then
  Begin
    tbl := 'CREATE GENERATOR gen_ent_'+layername;
    CreateElement(tbl);
    //tbl := 'SET GENERATOR gen_ent_' + layername + ' TO 0';
    //CreateElement(tbl);
  End;

  If Not GeneratorExists( 'gen_rtx_' + LayerName, IBSQL ) then
  Begin
    tbl := 'CREATE GENERATOR gen_rtx_'+layername;
    CreateElement(tbl);
    //tbl:= 'SET GENERATOR gen_rtx_' + layername + ' TO ';
    //CreateElement(tbl);
  End;

  // TRIGGERS
  {If Not TriggerExists( 'set_ent_uid_' + LayerName, IBSQL ) then
  Begin
    tbl := TRIGGER_ENT;
    tbl:= StringReplace( tbl, '_xxx', '_' + LayerName, [rfReplaceAll, rfIgnoreCase] );
    CreateElement(tbl);
  End;

  If Not TriggerExists( 'set_rtx_pageid_' + LayerName, IBSQL ) then
  Begin
    tbl := TRIGGER_RTX;
    tbl:= StringReplace( tbl, '_xxx', '_' + LayerName, [rfReplaceAll, rfIgnoreCase] );
    CreateElement(tbl);
  End; }

  // addentity stored procedure
  If Not StoredProcExists( 'addentity_' + LayerName, IBSQL ) Then
  Begin
    tbl := SP_ADDENTITY;
    tbl:= StringReplace( tbl, '_xxx', '_' + LayerName, [rfReplaceAll, rfIgnoreCase] );
    CreateElement(tbl);
  End;

  // add node procedure
  If Not StoredProcExists( 'addnode_' + LayerName, IBSQL ) Then
  Begin
    tbl := SP_ADDNODE;
    tbl:= StringReplace( tbl, '_xxx', '_' + LayerName, [rfReplaceAll, rfIgnoreCase] );
    CreateElement(tbl);
  End;

  // rtree search procedure
  If Not StoredProcExists( 'search_' + LayerName, IBSQL ) Then
  Begin
    tbl := SP_SEARCH1+SP_SEARCH2;
    tbl:= StringReplace( tbl, '_xxx', '_' + LayerName, [rfReplaceAll, rfIgnoreCase] );
    CreateElement(tbl);
  End;

End;

Procedure CreateGlobalElements( IBSQL: TIBSQL );
Begin
  With IBSQL Do
  Begin

    If Not TableExists( 'temp_records', IBSQL ) Then
    begin
      SQL.Text := 'CREATE TABLE temp_records (uid INT NOT NULL PRIMARY KEY)';
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    end;

    If Not InterbaseUDFExists( 'ezsearch_init', IBSQL ) Then
    Begin
      SQL.Text := SQL_DECLAREUDF1;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;

    If Not InterbaseUDFExists( 'ezsearch_find', IBSQL ) Then
    Begin
      SQL.Text := SQL_DECLAREUDF2;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;

    If Not InterbaseUDFExists( 'ezsearch_first', IBSQL ) Then
    Begin
      SQL.Text := SQL_DECLAREUDF3;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;

    If Not InterbaseUDFExists( 'ezsearch_next', IBSQL ) Then
    Begin
      SQL.Text := SQL_DECLAREUDF4;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;

    If Not InterbaseUDFExists( 'ezsearch_finish', IBSQL ) Then
    Begin
      SQL.Text := SQL_DECLAREUDF5;
      IBStartTrans( IBSQL );
      ExecQuery;
      IBCommitTrans( IBSQL );
      Close;
    End;
  End;

End;

Procedure LeftSet( Var s: String; Const value: String; start, len: integer );
Var
  i: integer;
Begin
  For i := 1 To ezlib.imin( length( value ), len ) Do
    s[start + i - 1] := value[i];
End;

Procedure SetDataToString( Const Data: TDiskPage; Var s: String );
Var
  i: integer;
Begin
  SetLength( s, 12 * 5 * 50 );
  FillChar( s[1], 12 * 5 * 50, #32 );
  For i := 0 To Data.FullEntries - 1 Do
  Begin
    LeftSet( s, IntToStr( Data.Entries[i].R.x1 ), i * ( 12 * 5 ) + 1, 12 );
    LeftSet( s, IntToStr( Data.Entries[i].R.y1 ), i * ( 12 * 5 ) + 13, 12 );
    LeftSet( s, IntToStr( Data.Entries[i].R.x2 ), i * ( 12 * 5 ) + 25, 12 );
    LeftSet( s, IntToStr( Data.Entries[i].R.y2 ), i * ( 12 * 5 ) + 37, 12 );
    LeftSet( s, IntToStr( Data.Entries[i].Child ), i * ( 12 * 5 ) + 49, 12 );
  End;
End;

Procedure SetStringToData( Const s: String; Var Data: TDiskPage );
Var
  i: integer;
Begin
  FillChar( Data.Entries, sizEof( Data.Entries ), 0 );
  For i := 0 To Data.FullEntries - 1 Do
  Begin
    Data.Entries[i].R.x1 := StrToInt( TrimRight( copy( s, i * ( 12 * 5 ) + 1, 12 ) ) );
    Data.Entries[i].R.y1 := StrToInt( TrimRight( copy( s, i * ( 12 * 5 ) + 13, 12 ) ) );
    Data.Entries[i].R.x2 := StrToInt( TrimRight( copy( s, i * ( 12 * 5 ) + 25, 12 ) ) );
    Data.Entries[i].R.y2 := StrToInt( TrimRight( copy( s, i * ( 12 * 5 ) + 37, 12 ) ) );
    Data.Entries[i].Child := StrToInt( TrimRight( copy( s, i * ( 12 * 5 ) + 49, 12 ) ) );
  End;
End;


{------------------------------------------------------------------------------}
{                  TEzIBTable - class implementation                          }
{------------------------------------------------------------------------------}

Function TEzIBTable.Dataset: TIBSQL;
Begin
  { regresa el dataset que se esta usando en ese momento}
  Result:= FLayer.DataSet;
End;

Function TEzIBTable.GetActive: boolean;
Begin
  result := Dataset.Open;
End;

Procedure TEzIBTable.SetActive( Value: boolean );
Begin
  // nothing to do here
End;

Function TEzIBTable.GetRecNo: Integer;
Begin
  Result := FCurrRecno;
End;

Procedure TEzIBTable.SetRecNo( Value: Integer );
Begin
  FCurrRecno:= Value;
End;

Procedure TEzIBTable.Append( NewRecno: Integer );
Begin
  // nothing to do here
End;

Function TEzIBTable.Bof: Boolean;
Begin
  result := Dataset.Bof;
End;

Function TEzIBTable.Eof: Boolean;
Begin
  result := Dataset.Eof;
End;

Procedure TEzIBTable.OpenIBSQL( Const ASQL: String );
Begin
  With DataSet Do
  Begin
    Close;
    SQL.Text := ASQL;
    IBStartTrans( DataSet );
    ExecQuery;
  End;
End;

Procedure TEzIBTable.ExecuteIBSQL( Const Asql: String );
Begin
  With Dataset Do
  Begin
    Close;
    SQL.Text := Asql;
    IBStartTrans( Dataset );
    ExecQuery;
    IBCommitTrans( Dataset );
    Close;
  End;
End;

Function TEzIBTable.DateGet( Const FieldName: String ): TDateTime;
Begin
  OpenIBSQL( Format( 'SELECT %s FROM %s WHERE uid = %d', [FieldName, Self.TheTableName, FCurrRecno] ) );
  result := Dataset.Fields[0].AsDateTime;
  IBCommitTrans( Dataset );
  Dataset.Close;
End;

Function TEzIBTable.DateGetN( FieldNo: integer ): TDateTime;
Begin
  OpenIBSQL( Format( 'SELECT * FROM %s WHERE uid = %d', [Self.TheTableName, FCurrRecno] ) );
  result := Dataset.Fields[FieldNo-1].AsDateTime;
  IBCommitTrans( Dataset );
  Dataset.Close;
End;

Function TEzIBTable.Deleted: Boolean;
Begin
  result := FLayer.RecIsDeleted;
End;

Function TEzIBTable.Field( FieldNo: integer ): String;
Begin
  OpenIBSQL( Format( 'SELECT * FROM %s WHERE uid = %d', [Self.TheTableName, FCurrRecno] ) );
  result := Dataset.Fields[FieldNo-1].Name;
  IBCommitTrans( Dataset );
  Dataset.Close;
End;

Function TEzIBTable.FieldCount: integer;
Begin
  OpenIBSQL( Format( 'SELECT * FROM %s WHERE uid = %d', [Self.TheTableName, FCurrRecno] ) );
  result:=dataset.Current.Count;
  IBCommitTrans( Dataset );
  Dataset.Close;
End;

Function TEzIBTable.FieldDec( FieldNo: integer ): integer;
Begin
  Result:=0;