unit uADOConnection;

interface

uses ADODB, Rubies;

var
  cADOConnection: Tvalue;

function ap_cADOConnection: Tvalue;
function ap_iADOConnection(real: TADOConnection; owner: Tvalue): Tvalue;
procedure Init_ADOConnection;

implementation

uses
  SysUtils, Classes, OleDB, uDefUtils, Pythia,
  uRDBExt, uADODataSet, uADOTable, uADOQuery, uADOStoredProc, uProperty;

function dl_ObjectStates(v:Tvalue):TObjectStates;
var
  a: Integer;
  b: TObjectStates absolute a;
begin
  a := dl_Set(v);
  result := b;
end;

function ap_ObjectStates(v:TObjectStates):Tvalue;
begin
  result := ap_Set(v);
end;

function ap_cADOConnection: Tvalue;
begin
  result := cADOConnection;
end;

function ADOConnection_event_handle(This, name: Tvalue): Tvalue; cdecl;
begin
  EventHandle(This, name, [RDBGetHandle]);
  result := Qnil;
end;

procedure CompoFree(real: TComponent); cdecl;
begin
  try
    real.tag := 0;
    if csDestroying in real.ComponentState then
      PhiObjectList.Extract(real)
    else
      PhiObjectList.Remove(real);
  except
    on E: Exception do;
  end;
end;

procedure ADOConnection_free(real: TADOConnection); cdecl;
begin
  if real.Connected then real.Close;
  CompoFree(real);
end;

// CompoAlloc modified
function ADOConnection_alloc1(This: Tvalue; real: TADOConnection): Tvalue;
begin
  if real = nil then begin result := Qnil; exit; end;
  PhiObjectList.Add(real);
  result := rb_data_object_alloc(This, real, nil, @ADOConnection_free);
  rb_iv_set(result, '@events', rb_hash_new);
  real.tag := result;
end;

function ADOConnection_alloc(This: Tvalue; real: TADOConnection): Tvalue;
begin
  result := ChildAlloc(This, real);
end;

function ap_iADOConnection(real: TADOConnection; owner: Tvalue): Tvalue;
begin
  result := ADOConnection_alloc(cADOConnection, real);
  ap_owner(result, owner);
end;

function ap_iADOConnection_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iADOConnection(TADOConnection(obj), owner);
end;

function ADOConnection_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  args: array of Tvalue;
begin
  real := TADOConnection.Create(nil);
  if argc > 0 then
  begin
    SetLength(args, argc);
    args := argv;
    try
      real.ConnectionString := dl_String(args[0]);
      real.LoginPrompt := False;
    except
      on E: Exception do
        ap_raise(ap_eDatabaseError, E.message);
    end;
  end;
  result := ADOConnection_alloc1(This, real);
  rb_obj_call_init(result, argc, argv);
end;

function ADOConnection_execute(This, sql: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  RecordsAffected: Integer;
begin
  result := Qnil;
  real := ap_data_get_struct(This);
  try
    real.Execute(dl_String(sql), RecordsAffected);
    result := INT2FIX(RecordsAffected);
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function ADOConnection_close(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  real.Close;
  result := Qnil;
end;

function ADOConnection_begin_trans(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.BeginTrans;
  except on E: Exception do
    ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function ADOConnection_commit_trans(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.CommitTrans;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function ADOConnection_rollback_trans(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  try
    real.RollbackTrans;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
  result := This;
end;

function ADOConnection_get_table_names(argc: integer; argv: Tvalue_array; This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  SystemTable : boolean;
begin
  result := ap_StringList_new;
  real := ap_data_get_struct(This);
  SystemTable := False; // default
  if argc > 1 then ap_raise(ap_eArgError, sWrong_num_of_args);
  if argc > 0 then SystemTable := dl_Boolean(argv[0]);
  real.GetTableNames( dl_Strings(result), SystemTable );
end;

function ADODataSetTmpAlloc(DataSet: TCustomADODataSet; owner: Tvalue): Tvalue;
begin
  if DataSet is TADODataSet then
    result := ap_iADODataSet(TADODataSet(DataSet), owner)
  else if DataSet is TADOTable then
    result := ap_iADOTable(TADOTable(DataSet), owner)
  else if DataSet is TADOQuery then
    result := ap_iADOQuery(TADOQuery(DataSet), owner)
  else if DataSet is TADOStoredProc then
    result := ap_iADOStoredProc(TADOStoredProc(DataSet), owner)
  else
    result := Qnil { error };
end;

function ADOConnection_get_data_sets(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  i:integer;
begin
  result := rb_ary_new;
  real := ap_data_get_struct(This);
  try
    for i := 0 to real.DataSetCount-1 do
    begin
      rb_ary_push(result, ADODataSetTmpAlloc(real.DataSets[i], This));
    end;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function ADOConnection_open_schema(This, schema, restrictions, schema_id, dataset: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  real.OpenSchema(TSchemaInfo(dl_Integer(schema)), dl_Variant(restrictions), dl_Variant(schema_id), dl_ADODataSet(dataset));
  result := Qnil;
end;

function ADOConnection_get_properties(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
   real: TADOConnection;
   args: array of Tvalue;
begin
   if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
   SetLength(args, argc);
   args := argv;
   real := ap_data_get_struct(This);
   result := ap_iProperty(real.Properties[dl_Variant(args[0])], This);
end;

(**** str2 made by ap_src_maker ****)

function ADOConnection_cancel(This : Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  real.Cancel;
  result := This;
end;

function ADOConnection_get_procedure_names(This, List : Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  dl_List : TStrings;
begin
  real := ap_data_get_struct(This);
  dl_List := ap_data_get_struct(List);
  real.GetProcedureNames( dl_List );
  result := This;
end;

function ADOConnection_get_field_names(This, TableName, List : Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  dl_TableName : string;
  dl_List : TStrings;
begin
  real := ap_data_get_struct(This);
  dl_TableName := dl_String(TableName);
  dl_List := ap_data_get_struct(List);
  real.GetFieldNames( dl_TableName, dl_List );
  result := This;
end;

function ADOConnection_open(This, UserID, Password : Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
  dl_UserID : WideString;
  dl_Password : WideString;
begin
  real := ap_data_get_struct(This);
  dl_UserID := dl_String(UserID);
  dl_Password := dl_String(Password);
  real.Open( dl_UserID, dl_Password );
  result := This;
end;

function ADOConnection_get_command_count(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.CommandCount);
end;

function ADOConnection_get_in_transaction(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.InTransaction);
end;

function ADOConnection_get_state(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_ObjectStates(real.State);
end;

function ADOConnection_get_version(This: Tvalue): Tvalue; cdecl;
var
  real: TADOConnection;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Version);
end;
(**** made by ap_src_maker ****)

procedure Init_ADOConnection;
begin
  RDBDataSetTmpAllocFuncList.Add(@ADODataSetTmpAlloc);

  rb_define_const(ap_mRDB, 'DBPROPVAL_TC_NONE', INT2FIX(DBPROPVAL_TC_NONE));
  DefineConstSetType(ap_mRDB, TypeInfo(TSchemaInfo));
  cADOConnection := DefinePersistentClass(ap_mRDB, TADOConnection, ap_cComponent, ap_iADOConnection_v);
  rb_define_method(cADOConnection, 'event_handle', @ADOConnection_event_handle, 1);
  DefineSingletonMethod(cADOConnection, 'new', ADOConnection_new);
  rb_define_method(cADOConnection, 'execute', @ADOConnection_execute, 1);
  rb_define_method(cADOConnection, 'close', @ADOConnection_close, 0);
  rb_define_method(cADOConnection, 'begin_trans', @ADOConnection_begin_trans, 0);
  rb_define_alias(cADOConnection, 'start_transaction', 'begin_trans');
  rb_define_method(cADOConnection, 'commit_trans', @ADOConnection_commit_trans, 0);
  rb_define_alias(cADOConnection, 'commit', 'commit_trans');
  rb_define_method(cADOConnection, 'rollback_trans', @ADOConnection_rollback_trans, 0);
  rb_define_alias(cADOConnection, 'rollback', 'rollback_trans');
  rb_define_method(cADOConnection, 'table_names', @ADOConnection_get_table_names, -1);
  rb_define_method(cADOConnection, 'open_schema', @ADOConnection_open_schema, 4);
  DefineAttrGet(cADOConnection, 'data_sets', ADOConnection_get_data_sets);
  DefineIndexer(cADOConnection, 'properties', @ADOConnection_get_properties, nil);

(**** str3 made by ap_src_maker ****)
  rb_define_method(cADOConnection, 'cancel', @ADOConnection_cancel, 0);
  rb_define_method(cADOConnection, 'get_procedure_names', @ADOConnection_get_procedure_names, 1);
  rb_define_method(cADOConnection, 'get_field_names', @ADOConnection_get_field_names, 2);
  rb_define_method(cADOConnection, 'open', @ADOConnection_open, 2);
  DefineAttrGet(cADOConnection, 'command_count', ADOConnection_get_command_count);
  DefineAttrGet(cADOConnection, 'in_transaction', ADOConnection_get_in_transaction);
  DefineAttrGet(cADOConnection, 'in_transaction?', ADOConnection_get_in_transaction);
  DefineAttrGet(cADOConnection, 'state', ADOConnection_get_state);
  DefineAttrGet(cADOConnection, 'version', ADOConnection_get_version);
(**** made by ap_src_maker ****)
end;

end.
