unit uPSI_Databases;
{
This file has been generated by UnitParser v0.7, written by M. Knight
and updated by NP. v/d Spek and George Birbilis.
Source Code from Carlo Kok has been used to implement various sections of
UnitParser. Components of ROPS are used in the construction of UnitParser,
code implementing the class wrapper is taken from Carlo Kok's conv utility

}
interface



uses
   SysUtils
  ,Classes
  ,uPSComponent
  ,uPSRuntime
  ,uPSCompiler
  ;

type
(*----------------------------------------------------------------------------*)
  TPSImport_Databases = class(TPSPlugin)
  public
    procedure CompileImport1(CompExec: TPSScript); override;
    procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
  end;


{ compile-time registration functions }
procedure SIRegister_TDBQuery(CL: TPSPascalCompiler);
procedure SIRegister_TFieldList(CL: TPSPascalCompiler);
procedure SIRegister_TDBConnection(CL: TPSPascalCompiler);
procedure SIRegister_Databases(CL: TPSPascalCompiler);

{ run-time registration functions }
procedure RIRegister_TDBQuery(CL: TPSRuntimeClassImporter);
procedure RIRegister_TFieldList(CL: TPSRuntimeClassImporter);
procedure RIRegister_TDBConnection(CL: TPSRuntimeClassImporter);
procedure RIRegister_Databases(CL: TPSRuntimeClassImporter);

function PSPluginCreate(): TPSPlugin; stdcall;

implementation


uses
   DB
  ,Databases
  ;


function PSPluginCreate(): TPSPlugin;
var
  Import: TPSImport_Databases;
begin
  Import:= TPSImport_Databases.Create(nil);
  Result := Import;
end;

(* === compile-time registration functions === *)
(*----------------------------------------------------------------------------*)
procedure SIRegister_TDBQuery(CL: TPSPascalCompiler);
begin
  //with RegClassS(CL,'TObject', 'TDBQuery') do
  with CL.AddClassN(CL.FindClass('TObject'),'TDBQuery') do
  begin
    RegisterMethod('Constructor Create');
    RegisterMethod('Procedure Open');
    RegisterMethod('Procedure Close');
    RegisterMethod('Procedure Next');
    RegisterMethod('Procedure First');
    RegisterMethod('Procedure Last');
    RegisterMethod('Procedure Previous');
    RegisterMethod('Procedure Append');
    RegisterMethod('Procedure Edit');
    RegisterMethod('Procedure Post');
    RegisterMethod('Procedure ExecSQL');
    RegisterMethod('Function Eof : boolean');
    RegisterMethod('Function FieldByNameAsBoolean( FieldName : string) : Boolean');
    RegisterMethod('Function FieldByNameAsDateTime( FieldName : string) : TDateTime');
    RegisterMethod('Function FieldByNameAsFloat( FieldName : string) : Double');
    RegisterMethod('Function FieldByNameAsInteger( FieldName : string) : Longint');
    RegisterMethod('Function FieldByNameAsString( FieldName : string) : String');
    RegisterProperty('Active', 'boolean', iptrw);
    RegisterProperty('SQL', 'TStrings', iptr);
    RegisterProperty('Connection', 'TDBConnection', iptrw);
    RegisterProperty('Fields', 'TFieldList', iptrw);
  end;
end;

(*----------------------------------------------------------------------------*)
procedure SIRegister_TFieldList(CL: TPSPascalCompiler);
begin
  //with RegClassS(CL,'TObject', 'TFieldList') do
  with CL.AddClassN(CL.FindClass('TObject'),'TFieldList') do
  begin
    RegisterMethod('Constructor Create( ADataSet : TObject)');
    RegisterMethod('Procedure Add( Field : TField)');
    RegisterMethod('Procedure CheckFieldName( const FieldName : string)');
    RegisterMethod('Procedure CheckFieldNames( const FieldNames : string)');
    RegisterMethod('Procedure Clear');
    RegisterMethod('Procedure ClearAutomatic');
    RegisterMethod('Function FindField( const FieldName : string) : TField');
    RegisterMethod('Function FieldByName( const FieldName : string) : TField');
    RegisterMethod('Function FieldByNumber( FieldNo : Integer) : TField');
    RegisterMethod('Procedure GetFieldNames( List : TStrings)');
    RegisterMethod('Function IndexOf( Field : TField) : Integer');
    RegisterMethod('Procedure Remove( Field : TField)');
    RegisterProperty('Dataset', 'TObject', iptr);
    RegisterProperty('Count', 'Integer', iptr);
    RegisterProperty('Fields', 'TField Integer', iptrw);
    SetDefaultPropery('Fields');
  end;
end;

(*----------------------------------------------------------------------------*)
procedure SIRegister_TDBConnection(CL: TPSPascalCompiler);
begin
  //with RegClassS(CL,'TObject', 'TDBConnection') do
  with CL.AddClassN(CL.FindClass('TObject'),'TDBConnection') do
  begin
    RegisterMethod('Constructor Create');
    RegisterMethod('Procedure Open( )');
    RegisterMethod('Procedure Close( )');
    RegisterProperty('ProviderName', 'AnsiString', iptrw);
    RegisterProperty('UserName', 'string', iptrw);
    RegisterProperty('Password', 'string', iptrw);
    RegisterProperty('Server', 'string', iptrw);
    RegisterProperty('Port', 'integer', iptrw);
    RegisterProperty('Database', 'string', iptrw);
    RegisterProperty('Connected', 'boolean', iptrw);
    RegisterProperty('Params', 'TStringList', iptr);
  end;
end;

(*----------------------------------------------------------------------------*)
procedure SIRegister_Databases(CL: TPSPascalCompiler);
begin
  SIRegister_TDBConnection(CL);
  SIRegister_TFieldList(CL);
  SIRegister_TDBQuery(CL);
end;

(* === run-time registration functions === *)
(*----------------------------------------------------------------------------*)
procedure TDBQueryFields_W(Self: TDBQuery; const T: TFieldList);
begin Self.Fields := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBQueryFields_R(Self: TDBQuery; var T: TFieldList);
begin T := Self.Fields; end;

(*----------------------------------------------------------------------------*)
procedure TDBQueryConnection_W(Self: TDBQuery; const T: TDBConnection);
begin Self.Connection := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBQueryConnection_R(Self: TDBQuery; var T: TDBConnection);
begin T := Self.Connection; end;

(*----------------------------------------------------------------------------*)
procedure TDBQuerySQL_R(Self: TDBQuery; var T: TStrings);
begin T := Self.SQL; end;

(*----------------------------------------------------------------------------*)
procedure TDBQueryActive_W(Self: TDBQuery; const T: boolean);
begin Self.Active := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBQueryActive_R(Self: TDBQuery; var T: boolean);
begin T := Self.Active; end;

(*----------------------------------------------------------------------------*)
procedure TFieldListFields_W(Self: TFieldList; const T: TField; const t1: Integer);
begin Self.Fields[t1] := T; end;

(*----------------------------------------------------------------------------*)
procedure TFieldListFields_R(Self: TFieldList; var T: TField; const t1: Integer);
begin T := Self.Fields[t1]; end;

(*----------------------------------------------------------------------------*)
procedure TFieldListCount_R(Self: TFieldList; var T: Integer);
begin T := Self.Count; end;

(*----------------------------------------------------------------------------*)
procedure TFieldListDataset_R(Self: TFieldList; var T: TObject);
begin T := Self.Dataset; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionParams_R(Self: TDBConnection; var T: TStringList);
begin T := Self.Params; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionConnected_W(Self: TDBConnection; const T: boolean);
begin Self.Connected := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionConnected_R(Self: TDBConnection; var T: boolean);
begin T := Self.Connected; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionDatabase_W(Self: TDBConnection; const T: string);
begin Self.Database := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionDatabase_R(Self: TDBConnection; var T: string);
begin T := Self.Database; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionPort_W(Self: TDBConnection; const T: integer);
begin Self.Port := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionPort_R(Self: TDBConnection; var T: integer);
begin T := Self.Port; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionServer_W(Self: TDBConnection; const T: string);
begin Self.Server := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionServer_R(Self: TDBConnection; var T: string);
begin T := Self.Server; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionPassword_W(Self: TDBConnection; const T: string);
begin Self.Password := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionPassword_R(Self: TDBConnection; var T: string);
begin T := Self.Password; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionUserName_W(Self: TDBConnection; const T: string);
begin Self.UserName := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionUserName_R(Self: TDBConnection; var T: string);
begin T := Self.UserName; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionProviderName_W(Self: TDBConnection; const T: AnsiString);
begin Self.ProviderName := T; end;

(*----------------------------------------------------------------------------*)
procedure TDBConnectionProviderName_R(Self: TDBConnection; var T: AnsiString);
begin T := Self.ProviderName; end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_TDBQuery(CL: TPSRuntimeClassImporter);
begin
  with CL.Add(TDBQuery) do
  begin
    RegisterConstructor(@TDBQuery.Create, 'Create');
    RegisterMethod(@TDBQuery.Open, 'Open');
    RegisterMethod(@TDBQuery.Close, 'Close');
    RegisterMethod(@TDBQuery.Next, 'Next');
    RegisterMethod(@TDBQuery.First, 'First');
    RegisterMethod(@TDBQuery.Last, 'Last');
    RegisterMethod(@TDBQuery.Previous, 'Previous');
    RegisterMethod(@TDBQuery.Append, 'Append');
    RegisterMethod(@TDBQuery.Edit, 'Edit');
    RegisterMethod(@TDBQuery.Post, 'Post');
    RegisterMethod(@TDBQuery.ExecSQL, 'ExecSQL');
    RegisterMethod(@TDBQuery.Eof, 'Eof');
    RegisterMethod(@TDBQuery.FieldByNameAsBoolean, 'FieldByNameAsBoolean');
    RegisterMethod(@TDBQuery.FieldByNameAsDateTime, 'FieldByNameAsDateTime');
    RegisterMethod(@TDBQuery.FieldByNameAsFloat, 'FieldByNameAsFloat');
    RegisterMethod(@TDBQuery.FieldByNameAsInteger, 'FieldByNameAsInteger');
    RegisterMethod(@TDBQuery.FieldByNameAsString, 'FieldByNameAsString');
    RegisterPropertyHelper(@TDBQueryActive_R,@TDBQueryActive_W,'Active');
    RegisterPropertyHelper(@TDBQuerySQL_R,nil,'SQL');
    RegisterPropertyHelper(@TDBQueryConnection_R,@TDBQueryConnection_W,'Connection');
    RegisterPropertyHelper(@TDBQueryFields_R,@TDBQueryFields_W,'Fields');
  end;
end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_TFieldList(CL: TPSRuntimeClassImporter);
begin
  with CL.Add(TFieldList) do
  begin
    RegisterConstructor(@TFieldList.Create, 'Create');
    RegisterMethod(@TFieldList.Add, 'Add');
    RegisterMethod(@TFieldList.CheckFieldName, 'CheckFieldName');
    RegisterMethod(@TFieldList.CheckFieldNames, 'CheckFieldNames');
    RegisterMethod(@TFieldList.Clear, 'Clear');
    RegisterMethod(@TFieldList.ClearAutomatic, 'ClearAutomatic');
    RegisterMethod(@TFieldList.FindField, 'FindField');
    RegisterMethod(@TFieldList.FieldByName, 'FieldByName');
    RegisterMethod(@TFieldList.FieldByNumber, 'FieldByNumber');
    RegisterMethod(@TFieldList.GetFieldNames, 'GetFieldNames');
    RegisterMethod(@TFieldList.IndexOf, 'IndexOf');
    RegisterMethod(@TFieldList.Remove, 'Remove');
    RegisterPropertyHelper(@TFieldListDataset_R,nil,'Dataset');
    RegisterPropertyHelper(@TFieldListCount_R,nil,'Count');
    RegisterPropertyHelper(@TFieldListFields_R,@TFieldListFields_W,'Fields');
  end;
end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_TDBConnection(CL: TPSRuntimeClassImporter);
begin
  with CL.Add(TDBConnection) do
  begin
    RegisterConstructor(@TDBConnection.Create, 'Create');
    RegisterMethod(@TDBConnection.Open, 'Open');
    RegisterMethod(@TDBConnection.Close, 'Close');
    RegisterPropertyHelper(@TDBConnectionProviderName_R,@TDBConnectionProviderName_W,'ProviderName');
    RegisterPropertyHelper(@TDBConnectionUserName_R,@TDBConnectionUserName_W,'UserName');
    RegisterPropertyHelper(@TDBConnectionPassword_R,@TDBConnectionPassword_W,'Password');
    RegisterPropertyHelper(@TDBConnectionServer_R,@TDBConnectionServer_W,'Server');
    RegisterPropertyHelper(@TDBConnectionPort_R,@TDBConnectionPort_W,'Port');
    RegisterPropertyHelper(@TDBConnectionDatabase_R,@TDBConnectionDatabase_W,'Database');
    RegisterPropertyHelper(@TDBConnectionConnected_R,@TDBConnectionConnected_W,'Connected');
    RegisterPropertyHelper(@TDBConnectionParams_R,nil,'Params');
  end;
end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_Databases(CL: TPSRuntimeClassImporter);
begin
  RIRegister_TDBConnection(CL);
  RIRegister_TFieldList(CL);
  RIRegister_TDBQuery(CL);
end;



{ TPSImport_Databases }
(*----------------------------------------------------------------------------*)
procedure TPSImport_Databases.CompileImport1(CompExec: TPSScript);
begin
  SIRegister_Databases(CompExec.Comp);
end;
(*----------------------------------------------------------------------------*)
procedure TPSImport_Databases.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
begin
  RIRegister_Databases(ri);
end;
(*----------------------------------------------------------------------------*)


end.
