frame_udm.~pas

企业信息管理系统程序框架

unit frame_uDM;

interface

uses
  SysUtils, Classes, DB, ADODB, Dialogs, Forms, windows,
  {BetterADODataSet, }ADOXQuery;

type
  Tframe_DM = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
    procedure dosqlConnect;
    procedure doAccessConnect;
  public
    Con: TCustomConnection;
    Qry: TDataSet;
    { Public declarations }
    procedure doconnect; virtual;
    function GenQry: TDataSet; overload;
    function GenQry(con: TCustomConnection): TDataSet; overload;
// 执行SQL (Con)
    function ExecuteSQL(Con: TCustomConnection; SQLStr: string): boolean; overload;

// 执行SQL (GV_Con)
    function ExecuteSQL(SQLStr: string): boolean; overload;

// 执行SQL (Qry)
    function ExecuteSQL(Qry: TDataSet; SQLStr: string): boolean; overload;

// 执行SQL （带参数)
    function ExecuteSQL(qry: TDataSet; SQLStr: string; Params: array of string): boolean;
      overload;

// 执行SQL （带参数)
    function ExecuteSQL(SQLStr: string; Params: array of string): boolean; overload;
    function OpenSQL(Qry: TDataSet; SQLStr: string; Params: array of string): boolean; overload;
    function OpenSQL(Qry: TDataSet; SQLStr: string;
      Params: TStringList): boolean; overload;
 // 把SQL的结果集填写到给strings里面
    procedure AddItems(aQry: TDataSet; SQLStr: string; cbb: TStrings;
      AddNull: boolean; AddOther: boolean);

  end;

var
  frame_DM: Tframe_DM;
  DMClass: TComponentClass;
implementation

uses frame_UtilFunc, frame_sysparam, frame_setDataBase;

{$R *.dfm}

 // DataModuleCreate
 // 功能: 创建连接

function Tframe_DM.ExecuteSQL(Qry: TDataSet; SQLStr: string): boolean;
var
  errMess: string;
  ADOQry: TADOxQuery;
begin
  Result := False;
  try
    if (Qry is TADOxQuery) then
    begin
      ADOQry := TADOxQuery(Qry);
      ADOQry.Close;
      ADOQry.SQL.Clear;
      ADOQry.SQL.Add(SQLSTR);
      ADOQry.ExecSQL;
    end;
  except
    on e: Exception do
    begin
      errMess := '执行SQL错误' + #13 + #10 +
        'SQL:' + SQLStr + #13 + #10 +
        e.message;
      errorDlg(errMess);
      WriteLog(errMess);
    end;
  end;
  if errmess = '' then
  begin
    Result := True
  end;
end;

procedure Tframe_DM.DataModuleCreate(Sender: TObject);
var
  userID, pwd, server, port, sid: string;
begin
  doConnect;
  qry := tAdoxquery.Create(self);
  (qry as TADOXQuery).Connection := TADOConnection(con);


  GV_Con := Con;
  GV_qry := qry;
end;

 //------------------------------------------------------------------------------
 // 执行SQL (Con)
 //------------------------------------------------------------------------------

function Tframe_DM.ExecuteSQL(SQLStr: string): boolean;
begin
  Result := False;
  if (GV_Con = nil) then
  begin
    raise EAppexception.CreateFmt('ExecuteSQL:没有设定默认Connection', [])
  end;
  Result := ExecuteSQL(GV_Con, SQLStr);

end;
 //------------------------------------------------------------------------------
 // 执行SQL(带参数)
 //------------------------------------------------------------------------------

function Tframe_DM.ExecuteSQL(Qry: TDataSet; SQLStr: string; Params: array of string): boolean;
var
  i: integer;
  errMess: string;
  ADOQry: TADOxQuery;
begin
  Result := False;
  try
    if (Qry is TADOxQuery) then
    begin
      ADOQry := TADOxQuery(Qry);
      ADOQry.SQL.Clear;
      ADOQry.SQL.Add(SQLStr);


      if ADOQry.Parameters.Count <> High(params) + 1 then
      begin
        errMess := 'ExecuteSQL:参数不足!';
        errorDlg(errMess);
        WriteLog(errMess);
        exit;
      end;
      for i := 0 to ADOQry.Parameters.Count - 1 do
      begin
        ADOQry.Parameters[i].Value := params[i];
      end;
      ADOQry.open;
    end;
  except
    on e: Exception do
    begin
      errMess := '执行SQL错误' + #13 + #10 +
        'SQL:' + SQLStr + #13 + #10 +
        e.message;
      errorDlg(errMess);
      WriteLog(errMess);
    end;
  end;
  if errmess = '' then
  begin
    Result := True
  end;
end;

 //------------------------------------------------------------------------------
 // 执行SQL(带参数)
 //------------------------------------------------------------------------------



 //------------------------------------------------------------------------------
 // 执行SQL(带参数)
 //------------------------------------------------------------------------------

function Tframe_DM.ExecuteSQL(SQLStr: string; Params: array of string): boolean;
begin
  Result := False;
  if (GV_Qry = nil) then
  begin
    raise EAppexception.CreateFmt('ExcuteSQL:没有设定默认Qry', [])
  end;
  Result := ExecuteSQL(GV_Qry, SQLStr, Params);
end;

 //------------------------------------------------------------------------------
 // 执行SQL (Qry)
 //------------------------------------------------------------------------------

procedure Tframe_DM.doAccessConnect;
var
  datalinkstr, linkstr, userid, password, initialcatalog, datasource: string;
  adoconn: TADOConnection;
  adoqry: TAdoxquery;
begin
  Linkstr := readcfg('database', 'LinkStr', '');
  password := UncrypStr(ReadCfg('database', 'password', ''));
  datasource := readcfg('database', 'datasource', '');

  datalinkstr := format(Linkstr, [password, datasource]);
  adoconn := TADoConnection.create(self);
  adoconn.LoginPrompt := false;
  adoconn.Connected := false;
  adoconn.ConnectionString := datalinkstr;
  try
    adoconn.Connected := true;
  except
    adoconn.connected := false;
    Application.messagebox('数据库参数配置不正确！', '提示', mb_ok +
      mb_iconinformation);
    with tf_setdatabase.create(self) do
    begin
      showmodal;
      free;
    end;
  end;
  if not adoConn.Connected then
    Application.Terminate;
  Con := adoconn;
  adoqry := tAdoxquery.Create(self);
  adoqry.Connection := adoconn;
  qry := adoqry;
end;



function Tframe_DM.GenQry: TDataSet;
begin
  result := GenQry(con);
end;

procedure Tframe_DM.doconnect;
begin

end;

procedure TFrame_DM.AddItems(aQry: TDataSet; SQLStr: string; cbb: TStrings;
  AddNull: boolean; AddOther: boolean);
begin
  with aQry do
  begin
    ExecuteSQL(aQry, SQLStr);
    First;
    cbb.Clear;
    if AddNull then
    begin
      cbb.Add('')
    end;
    while not EOF do
    begin
      if fields[0].AsString <> '' then
      begin
        cbb.add(Fields[0].AsString)
      end;
      Next;
    end;
    Close;
    if AddOther then
    begin
      cbb.add('其他..')
    end;
  end;

end;

procedure Tframe_DM.dosqlConnect;
begin

end;

function Tframe_DM.ExecuteSQL(Con: TCustomConnection;
  SQLStr: string): boolean;

var
  ADOSQL: TADOxQuery;
  errMess: string;
begin
  Result := False;
  if (Con is TADOConnection) then
  begin
    ADOSQL := TADOxQuery.Create(Application);
    ADOSQL.Connection := TADOConnection(con);
    ADOSQL.SQL.Add(SQLStr);
    try
      ADOSQL.ExecSQL;
    except
      on e: Exception do
      begin
        Result := False;
        errMess := '执行SQL错误' + #13 + #10 +
          'SQL:' + SQLStr + #13 + #10 +
          e.message;
        errorDlg(errMess);
        WriteLog(errMess);
      end;
    end;
  end;

  if errmess = '' then
  begin
    Result := True
  end;
end;


function Tframe_DM.GenQry(con: TCustomConnection): TDataSet;
var
  adoqry: TADOxQuery;
begin
  ADOQry := TADOxQuery.Create(self);
  ADOQry.Connection := TADOConnection(Con);
  result := adoqry;
end;


function Tframe_DM.OpenSQL(Qry: TDataSet; SQLStr: string;
  Params: array of string): boolean;
var
  i: integer;
  a: TStringList;
begin
  a := TStringList.Create;
  for i := 0 to high(params) do
  begin
    a.Add(Params[i]);
  end;
  OpenSQL(Qry, sqlstr, a);
  a.Free;
end;

function Tframe_DM.OpenSQL(Qry: TDataSet; SQLStr: string;
  Params: TStringList): boolean;
var
  i: integer;
  errMess: string;
  ADOQry: TADOxQuery;
begin
  if qry.Active then Qry.Close;
  Result := False;
  try
    if (Qry is TADOxQuery) then
    begin
      ADOQry := TADOxQuery(Qry);
      ADOQry.SQL.Clear;
      ADOQry.SQL.Add(SQLStr);
      ADOQry.Prepared := true;

      if Params <> nil then
      begin
        if ADOQry.Parameters.Count <> Params.Count then
        begin
          errMess := 'ExecuteSQL:参数不足!';
          errorDlg(errMess);
          WriteLog(errMess);
          exit;
        end;
        for i := 0 to ADOQry.Parameters.Count - 1 do
        begin
          ADOQry.Parameters[i].Value := params[i];
        end;
      end;
      ADOQry.open;
    end;
  except
    on e: Exception do
    begin
      errMess := '执行SQL错误' + #13 + #10 +
        'SQL:' + SQLStr + #13 + #10 +
        e.message;
      errorDlg(errMess);
      WriteLog(errMess);
    end;
  end;
  if errmess = '' then
  begin
    Result := True
  end;
end;

initialization
  DMClass := Tframe_DM;
end.