怎样在DLL种共享TDATABASE???

Question

我写了一个DLL得函数,需要用TDATABASE做为参数,可调试时执行过程都能执行就是最后一步执行完后报地址冲突得错误,请高手帮忙!!!先谢了!!!
function PP_10001( ADatabase: TDatabase; AData: Pchar; AFile: Pchar): Integer; stdcall;
var
  vqry: TQuery;
begin
    Session := ADatabase.Session; //如不加这句总提示数据库得用户/密码不正确,加上后执行完最后一句就报地址冲突
    result := -1;
    try
    vQry := TQuery.Create(nil);
    try
       vQry.DatabaseName := ADatabase.DatabaseName;
       .....执行查询,修改等SQL操作
       result := 0;
    finally
        if vQry.Active then vQry.Close;
        vQry.Free;
    end;
    except
    end;
end;

Answer 1

我没有试过,建议你在DLL和你的主程序的工程的工程文件中的Uses部分,最先包含ShareMem
然后把bin\delphimm.dll拷贝到你程序运行的目录,发布时也发布这个文件.
如果不行我就没有办法了.

Answer 2

没法帮你了，建议你修改程序结构，不要在DLL中访问数据库，和进行数据处理。

Answer 3

怎样用BPL封装数据库操作，可我不想在BPL中打开数据库连接，想公用主程序的数据库连接

Answer 4

我原来做过一次，传的是ADOConnect 可用操作，一切正常，但是关闭时就有非法操作，因为这种方法跨内存了。后来用映射内存的方式，好像还是不行，还没试用BPL

Answer 5

给你个例子。我的一个工程中的一部分。也许对你有帮助。unit AIdentity;interfaceuses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,UserInformation,Singleton,MenuItem;type
  TAIdentity = class(TObject)
  private
    
  protected
    procedure GetMenuItems(PID:String); virtual; abstract;
    function GetMenus:MenuList;virtual;abstract;
    function GetTopMenus:TStringList;virtual;abstract;
  public
    constructor Create; virtual; abstract;
    procedure AddUser(userInfo:TUserInformation;out ErrorCode:Integer); virtual;
            abstract;
    procedure DeleteUser(UserID:string;out ErrorCode:Integer); virtual;
            abstract;
    function GetUserList: TStrings; virtual; abstract;
    function IdentityValidate(userID:string;passWord:string;var Singleton:TSingleton): Boolean;
            virtual; abstract;
    procedure ModifyUserInfo(userInfo:TUserInformation;out ErrorCode:Integer);
            virtual; abstract;
    property Menus: MenuList read GetMenus;
    property TopMenus:TStringList read GetTopMenus;
  end;
  
  TAIdentityClass = class of TAIdentity;implementation
end.

Answer 6

unit Identity;interfaceuses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,DB,
  Forms, Dialogs,AIdentity,UserInformation,DataModule,Singleton,MenuItem;type
  TIdentity = class(TAIdentity)
  private
    FDataModule: TMainDM;
    FMenus: MenuList;
    FTopMenus:TStringList;
  protected
    procedure GetMenuItems(PID:String); override;
    function GetMenus:MenuList;override ;
    function GetTopMenus:TStringList;override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure AddUser(userInfo:TUserInformation;out ErrorCode:Integer);
            override;
    procedure DeleteUser(UserID:string;out ErrorCode:Integer); override;
    function GetUserList: TStrings; override;
    function IdentityValidate(userID:string;passWord:string;var Singleton:TSingleton): Boolean;
            override;
    procedure ModifyUserInfo(userInfo:TUserInformation;out ErrorCode:Integer);
            override;
    property DataModule: TMainDM read FDataModule write FDataModule;
    property Menus:MenuList read GetMenus;
    property TopMenus:TStringList read GetTopMenus;
  end;
  implementationresourcestring
// START resource string wizard section  SIdentity_ISSHORT = 'ISSHORT';
  SIdentity_DUTY = 'DUTY';
  SIdentity_ICON = 'ICON';
  SIdentity_ISGROUP = 'ISGROUP';
  SIdentity_MENUID = 'MENUID';
  SIdentity_MENUNAME = 'MENUNAME';
  SIdentity_METHOD = 'METHOD';
  SIdentity_OPERATIONNAME = 'OPERATIONNAME';
  SIdentity_OPID = 'OPID';
  SIdentity_PARENTID = 'PARENTID';
  SIdentity_PERSONNELNAME = 'PERSONNELNAME';
  SIdentity_TARGETDLL = 'TARGETDLL';
  SIdentity_ISSUBITEM = 'ISSUBITEM';
// END resource string wizard section{
********************************** TIdentity ***********************************
}
constructor TIdentity.Create;
begin
  self.FDataModule := TMainDM.Create(nil);
end;destructor TIdentity.Destroy;
begin
  FreeAndNil(FDataModule);
end;procedure TIdentity.AddUser(userInfo:TUserInformation;out ErrorCode:Integer);
begin
end;procedure TIdentity.DeleteUser(UserID:string;out ErrorCode:Integer);
begin
end;
function TIdentity.GetMenus:MenuList;
begin
  if (FMenus = nil) then
  begin
    FTopMenus := TStringList.Create;
    try
      if (not FDataModule.Database.Connected) then
        FDataModule.Database.Open;      FDataModule.QIdentityValidate.SQL.Clear;
      FDataModule.QIdentityValidate.SQL.Text := CONST_TOPMENU;
      FDataModule.QIdentityValidate.Open;
      while (not FDAtaModule.QIdentityValidate.Eof) do
      begin
        FTopMenus.Add(FDAtaModule.QIdentityValidate.FieldValues[SIdentity_MENUID] +
                '=' + FDAtaModule.QIdentityValidate.FieldValues[SIdentity_MENUNAME]);
        FDataModule.QIdentityValidate.Next;
      end;
    finally
      FDataModule.Database.Close;
    end;
  end;
  Result := FMenus;
end;function TIdentity.GetTopMenus:TStringList;
begin
  if (FTopMenus = nil) then
    GetMenus;
  Result := FTopMenus;
end;procedure TIdentity.GetMenuItems(PID:String);
var
  MenuItem : TMenuItem;
  I:Integer;
begin
  I := 0;
  try
    if (not FDataModule.Database.Connected) then
      FDataModule.Database.Open;    FDataModule.QIdentityValidate.SQL.Clear;
    FDataModule.QIdentityValidate.SQL.Text := CONST_MENUITEMS;
    FDataModule.QIdentityValidate.Params[0].Value := PID;
    FDataModule.QIdentityValidate.Open;
    SetLength(FMenus,0);
    SetLength(FMenus,FdataModule.QIdentityValidate.RecordCount);
    while (not FDAtaModule.QIdentityValidate.Eof) do
    begin
      MenuItem := TMenuItem.Create;
      with FDataModule.QIdentityValidate do
      begin
        MenuItem.MenuID := FieldValues[SIdentity_MENUID];
        MenuItem.MenuCaption := FieldValues[SIdentity_MENUNAME];
        MenuItem.IsGroup := FieldValues[SIdentity_ISGROUP];
        MenuItem.ParentMenuID := FieldValues[SIdentity_PARENTID];
        MenuItem.ExecMethod := FieldValues[SIdentity_METHOD];
        MenuItem.TargetDLL := FieldValues[SIdentity_TARGETDLL];
        MenuItem.IsShort := FieldValues[SIdentity_ISSHORT];
        MenuItem.IsSubItem := FieldValues[SIdentity_ISSUBITEM];
        if (FieldByName(SIdentity_ICON).IsBlob) then
        begin
          MenuItem.MenuIcon.Assign(FieldByName(SIdentity_ICON));
        end;
      end;
      FMenus[I] := MenuItem;
      I := I + 1;
      FDataModule.QIdentityValidate.Next;
    end;
  finally
    FDataModule.Database.Close;
  end;
end;function TIdentity.GetUserList: TStrings;
var
  UserList: TStrings;
begin
  UserList := TStringList.Create;
  try
    if (not FDataModule.Database.Connected) then
      FDataModule.Database.Open;    FDataModule.QIdentityValidate.SQL.Clear;
    FDataModule.QIdentityValidate.SQL.Text := CONST_USER_LIST;
    FDataModule.QIdentityValidate.Open;
    while (not FDAtaModule.QIdentityValidate.Eof) do
    begin
      UserList.Add(FDataModule.QIdentityValidate.FieldValues[SIdentity_OPID] + '=' +
        FDataModule.QIdentityValidate.FieldValues[SIdentity_OPERATIONNAME]);
      FDataModule.QIdentityValidate.Next;
    end;
  finally
    FDataModule.Database.Close;
  end;
  Result := UserList;
end;function TIdentity.IdentityValidate(userID:string;passWord:string;var Singleton:TSingleton): Boolean;
begin
   try
    if (not FDataModule.Database.Connected) then
      FDataModule.Database.Open;      FDataModule.QIdentityValidate.SQL.Clear;
      FDataModule.QIdentityValidate.SQL.Text := CONST_IDENTITY_VALIDATE;
      FDataModule.QIdentityValidate.Params[0].Value := userID;
      FDataModule.QIdentityValidate.Params[1].Value := passWord;
      FDataModule.QIdentityValidate.Open;
      
      Result := FDataModule.QIdentityValidate.Fields[0].Value = userID;
      if (Result) then
      begin
        Singleton.User.UserID := userID;
        Singleton.User.UserName := FDataModule.QIdentityValidate.FieldValues[SIdentity_PERSONNELNAME];
        Singleton.User.LoginDate := Now;
        Singleton.User.Duty := FDataModule.QIdentityValidate.FieldValues[SIdentity_DUTY];
        Singleton.User.Identity := Result;
        GetMenus;
        GetMenuItems(userID);          
      end
    finally
      FDataModule.Database.Close;
    end;end;procedure TIdentity.ModifyUserInfo(userInfo:TUserInformation;out
        ErrorCode:Integer);
begin
end;end.library CommonModule;{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }uses
  ShareMem,
  SysUtils,
  Classes,
  DataModule in 'DataModule.pas' {MainDM: TDataModule},
  Identity in 'Identity.PAS',
  AIdentity in 'AIdentity.PAS',
  UserInformation in 'UserInformation.pas',
  MenuItem in 'MenuItem.PAS';{$R *.res}function TObjUsers:TAIdentityClass;
begin
  result:=TIdentity;
end;exports
  TObjUsers;
begin
end.这个例子是到处DLL中的一个类。有了这个类就可以做任何共享的事情了。

Answer 7

调用
private
    ObjUsers: TAIdentity;。。function TObjUsers:TAIdentityClass; external 'CommonModule.dll';。。procedure TFLogin.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  try
    ObjUsers := TObjUsers.Create;    UserList := ObjUsers.GetUserList;
    for i := 0 to UserList.Count - 1 do
      self.Combox_UserName.AddItem(UserList.Values[UserList.Names[i]],4,0);
    if (Combox_UserName.Items.Count > 0) then
      Combox_UserName.ItemIndex:= 0;      SetState(ltWarning);
  finally
   
  end;
end;