⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 datamod.pas

📁 SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi
💻 PAS
字号:
unit DataMod;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, SDCommon, SDEngine;

type
  TdmData = class(TDataModule)
    Database: TSDDatabase;
    qryQuery: TSDQuery;
    qryPersons: TSDQuery;
    updPersons: TSDUpdateSQL;
    procedure DatabaseLogin(Database: TSDDatabase; LoginParams: TStrings);
    procedure qryPersonsUpdateError(DataSet: TDataSet; E: EDatabaseError;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure qryPersonsUpdateRecord1(DataSet: TDataSet;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure qryPersonsUpdateRecord2(DataSet: TDataSet;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure qryPersonsAfterInsert(DataSet: TDataSet);
    procedure qryPersonsAfterOpen(DataSet: TDataSet);
    procedure dmDataCreate(Sender: TObject);
    procedure dmDataDestroy(Sender: TObject);
    procedure qryPersonsFilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
  private
    { Private declarations }
  public
    procedure CreateTestTable;
    procedure DropTestTable;
  end;

var
  dmData: TdmData;

implementation

uses
  Login;

{$R *.DFM}

{ TdmData }
procedure TdmData.CreateTestTable;
var
  q: TSDQuery;
begin
  q := TSDQuery.Create(Self);
  try
    q.DatabaseName := Database.DatabaseName;
    if not Database.Connected then Database.Open;
    if Database.ServerType in [stInterbase] then
      Database.StartTransaction;
    try
      q.SQL.Clear;
      case Database.ServerType of
        stDB2:
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE date, NOTE clob(2G) not logged)');
        stInformix:
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE date, NOTE text)');
        stInterbase:
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE timestamp, NOTE blob)');
        stSQLServer, stSybase:
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE datetime, NOTE text null)');
      else
        if (Database.ServerType = stOracle) and (Database.ServerMajor >= 8) and (Database.ClientMajor >= 8) then
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE date, NOTE clob)')
        else
          q.SQL.Add('create table TEST_PERSON(ID integer, NAME char(20), SURNAME char(20), BIRTH_DATE date, NOTE long)');
      end;
      q.ExecSQL;
      q.SQL.Clear;
      q.SQL.Add('create unique index PKTEST_PERSON on TEST_PERSON(ID)');
      q.ExecSQL;
      q.SQL.Clear;
      q.SQL.Add('create index AK1TEST_PERSON on TEST_PERSON(SURNAME)');
      q.ExecSQL;
      q.SQL.Clear;
      q.SQL.Add('create index AK2TEST_PERSON on TEST_PERSON(NAME)');
      q.ExecSQL;

      if Database.ServerType in [stInterbase] then
        Database.Commit;
    except
      on ESDEngineError do begin
        if Database.ServerType in [stInterbase] then
          Database.Rollback;
        raise;
      end;
    end;
  finally
    q.Free;
  end;
end;

procedure TdmData.DropTestTable;
var
  q: TSDQuery;
begin
  q := TSDQuery.Create(Self);
  try
    q.DatabaseName := Database.DatabaseName;
    if not Database.Connected then Database.Open;

    qryQuery.Disconnect;
    qryPersons.Disconnect;
    updPersons.Query[ukModify].Disconnect;
    updPersons.Query[ukInsert].Disconnect;
    updPersons.Query[ukDelete].Disconnect;

    if Database.ServerType in [stInterbase] then
      Database.StartTransaction;
    try
      q.SQL.Clear;
      q.SQL.Add('drop table TEST_PERSON');
      q.ExecSQL;
      q.Disconnect;

      if Database.ServerType in [stInterbase] then
        Database.Commit;
    except
      on ESDEngineError do begin
        if Database.ServerType in [stInterbase] then
          Database.Rollback;
        raise;
      end;
    end;
  finally
    q.Free;
  end;
end;

procedure TdmData.dmDataCreate(Sender: TObject);
begin
  Database.Open;
end;

procedure TdmData.dmDataDestroy(Sender: TObject);
begin
  Database.Close;
end;

procedure TdmData.DatabaseLogin(Database: TSDDatabase; LoginParams: TStrings);
begin
  Application.CreateForm(TLoginDlg, LoginDlg);
  LoginDlg.AssignDbValues(Database);
  with LoginDlg do try
    edUserName.Text := LoginParams.Values['USER NAME'];
    if ShowModal = mrOk then begin
      Database.ServerType	:= TSDServerType(cbServerType.ItemIndex);
      Database.RemoteDatabase	:= edDatabase.Text;
      LoginParams.Values['USER NAME']	:= edUserName.Text;
      LoginParams.Values['PASSWORD'] 	:= edPassword.Text;
    end else begin
      Application.Terminate;
      Application.ProcessMessages;
    end;
  finally
    Free;
  end;
end;

procedure TdmData.qryPersonsAfterOpen(DataSet: TDataSet);
begin
  DataSet.FieldByName('NOTE').Required := False;
end;

procedure TdmData.qryPersonsAfterInsert(DataSet: TDataSet);
begin
  DataSet.FieldByName('ID').AsInteger := 0;
end;
                                            
{ It is necessary to set OnUpdateError for avoid 'Update fail' error }
procedure TdmData.qryPersonsUpdateError(DataSet: TDataSet;
  E: EDatabaseError; UpdateKind: TUpdateKind;
  var UpdateAction: TUpdateAction);
begin
  UpdateAction := uaAbort;
end;

procedure TdmData.qryPersonsUpdateRecord1(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
var
  q: TSDQuery;
begin
  if UpdateKind = ukInsert then begin
    q := TSDQuery.Create(Self);
    try
      q.DatabaseName := Database.DatabaseName;
      q.SQL.Add('select MAX(ID)+1 from TEST_PERSON');
      q.Open;
      DataSet.Edit;
      DataSet.FieldByName('ID').AsInteger := q.Fields[0].AsInteger;
      DataSet.Post;
      q.Close;
    finally
      q.Free;
    end;
  end;
  updPersons.Apply(UpdateKind);
  UpdateAction := uaApplied;
end;

{ Example of the parameter's changing before apply }
procedure TdmData.qryPersonsUpdateRecord2(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
var
  q: TSDQuery;
begin
  if UpdateKind = ukInsert then begin
    q := TSDQuery.Create(Self);
    try
      q.DatabaseName := Database.DatabaseName;
      q.SQL.Add('select MAX(ID)+1 from TEST_PERSON');
      q.Open;
      DataSet.Edit;
      DataSet.FieldByName('ID').AsInteger := q.Fields[0].AsInteger;
      DataSet.Post;
      q.Close;
    finally
      q.Free;
    end;
  end;
	// set new value for the bind parameters
  updPersons.SetParams(UpdateKind);
  q := updPersons.Query[UpdateKind];	// get query, which will update database
// change BIRTH_DATE parameter by format string
  q.ParamByName('BIRTH_DATE').AsString := FormatDateTime( 'mm-dd-yyyy hh:nn:ss', q.ParamByName('BIRTH_DATE').AsDateTime );
// in onther case
//  q.ParamByName('BIRTH_DATE').AsString := FormatDateTime( 'dd.mm.yyyy hh:nn:ss', q.ParamByName('BIRTH_DATE').AsDateTime );
	// execute update statement
  updPersons.ExecSQL(UpdateKind);
  UpdateAction := uaApplied;
end;

procedure TdmData.qryPersonsFilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
  Accept := DataSet.FieldByName('ID').AsInteger > 5;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -