请问能否将下面的代码用Delphi 编译dll文件以及外部文件怎么调用

Question

我自学Delphi没有多久,在网上也搜过Delphi编译Dll文件的方法,其中都介绍得比较简单;
下面这段代码是我每写一个Delphi程序都需要干的事情,我想写成Dll文件,然后调用它;
这里还涉及到有很多参数需要在主程序中调用,不知行不?或者变通方法?如果行该怎么处理,请详细说明!
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, ExtCtrls;type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    ADOQuery3: TADOQuery;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  YCS,UserID,UserName,UserGroupID:string;                                                     
  {外挂程序句柄,用户编号,用户名称,用户组编号}
  BenR,Zhu,Taz,XianD:string;                                                                   
  {本人权限,组权限,他组权限,限定权限}
  rSee,rAlter,rDel,rSanction,rCancel,rPrint,rCost,rPrices,rNew,rTosign,rCashier,rAnnul:string; 
  {本人权限:查询,更改,删除,审核,撤消审核,打印,成本,售价,新增,送签,出纳,作废  }
  rGSee,rGAlter,rGDel,rGSanction,rGCancel,rGAnnul:string;                                     
  {组权限:查询,更改,删除,审核,撤消审核,作废  }
  rTGSee,rTGAlter,rTGDel,rTGSanction,rTGCancel,rTGAnnul:string;                               
  {他组权限:查询,更改,删除,审核,撤消审核,作废  }
  rClient,rWarehouse:string;                                                                  
  {客户,仓库}
  Const ProgramID='ABC';                                                                     
  {程序编号}implementation{$R *.dfm}
//接下

Answer 1

procedure TForm1.FormCreate(Sender: TObject);
var
  //以下声明是为传递消息所用
  ds: TCopyDataStruct;
  hd: THandle;
  //窗口句柄
  hCurWindow:HWnd;
  WinText:array[0..255] of char;
begin
    UserID:='';
    //获取第一个窗口的句柄
     hCurWindow:=GetWindow(Handle,GW_HWNDFirst);
     while hCurWindow<>0 do
        begin    //获取窗口的名称
             if (GetWindowText(hCurWindow,@WinText,255)>0) and (POS('外挂系统 [',WinText)>0) then
                   begin
                        YCS:=Trim(StrPas(@WinText));
                        UserID:=Trim(copy(YCS,POS('[',YCS)+1,POS('-',YCS)-1-POS('[',YCS) ));                     
                   end;
             hCurWindow:=GetWindow(hCurWindow,GW_HWNDNEXT);                         //获取下一个窗口的句柄
        end;
        with ADOQuery1 do
        begin
                 close;
                 SQL.Clear;
                 SQL.Text:='select MF001,MF002,MF004 FROM ADMMF WHERE MF001='+QuotedStr(UserID);
                 open;
        end;
        if  ADOQuery1.RecordCount=0 then
        begin
               UserID:='';
               UserName:='';
               UserGroupID:='';
        end
        else
        begin
               UserID:=ADOQuery1.Fields[0].Asstring;                                  //获取用名编号
               UserName:=ADOQuery1.Fields[1].Asstring;                                  //获取用户名称
               UserGroupID:=ADOQuery1.Fields[2].Asstring;                               //获取用户组编号
              //以下这段是外挂主界面传递能数用
               ds.cbData :=30;
               GetMem (ds.lpData, ds.cbData );
               StrCopy (ds.lpData, '开启窗体');
               Hd := FindWindow (nil, PChar(YCS));
               if Hd <> 0 then  SendMessage (Hd, WM_COPYDATA, Handle,Cardinal(@ds))   else   FreeMem (ds.lpData);   
        end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ds: TCopyDataStruct;
  hd: THandle;
begin
  ds.cbData :=30;
  GetMem (ds.lpData, ds.cbData );
  StrCopy (ds.lpData, '关闭窗体');
  Hd := FindWindow (nil, PChar(YCS));
  if Hd <> 0 then
  SendMessage (Hd, WM_COPYDATA, Handle,Cardinal(@ds))
  else
  FreeMem (ds.lpData);
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if FindWindow(nil,PChar(YCS)) = 0 then  Halt;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
        if UserID='' then
              begin
                    MessageBox(handle,'请您使用 [外挂系统] ！','温馨提示',MB_ICONASTERISK);
                    close;
              end
              else
              begin
                   with ADOQuery2 do
                   begin
                      Close;
                      SQL.Clear;
                      SQL.Text:='Select * From YCSPowerControl  Where 用户编号='''+UserID+''' AND 程序编号='''+ProgramID+'''';
                      Open;
                   end;
                   if  ADOQuery2.RecordCount=0 then
                       begin
                             MessageBox(handle,PChar('['+S+']作业程序无运行作业权限！'),'外挂系统',MB_ICONHAND);                       
                             {S是主程序的全局变量参数}
                             Close;
                       end
                       else
                       begin
                             with ADOQuery3 do
                             begin
                                 Close;
                                 SQL.Clear;
                                 SQL.Text:='Select * From PowerControl  Where 用户编号='''+UserID+''' AND 程序编号='''+ProgramID+'''';
                                 Open;
                                 BenR :=Trim(FieldByName('本人权限').Asstring);
                                 Zhu  :=Trim(FieldByName('组权限').Asstring);
                                 Taz  :=Trim(FieldByName('他组权限').Asstring);
                                 XianD:=Trim(FieldByName('限定权限').Asstring);
                                 if Copy(BenR,1,1)='Y'   then  rSee        := 'True'   else  rSee        := 'False';  
                                      if Copy(BenR,2,1)='Y'   then  rAlter      := 'True'   else  rAlter      := 'False';  
                                      if Copy(BenR,3,1)='Y'   then  rDel        := 'True'   else  rDel        := 'False';  
                                      if Copy(BenR,4,1)='Y'   then  rSanction   := 'True'   else  rSanction   := 'False'; 
                                      if Copy(BenR,5,1)='Y'   then  rCancel     := 'True'   else  rCancel     := 'False';            
                                      if Copy(BenR,6,1)='Y'   then  rPrint      := 'True'   else  rPrint      := 'False';            
                                      if Copy(BenR,7,1)='N'   then  rCost       := 'False'  else  rCost       := 'True';              
                                      if Copy(BenR,8,1)='N'   then  rPrices     := 'False'  else  rPrices     := 'True';              
                                      if Copy(BenR,9,1)='Y'   then  rNew        := 'True'   else  rNew        := 'False';             
                                      if Copy(BenR,10,1)='Y'  then  rTosign     := 'True'   else  rTosign     := 'False';             
                                      if Copy(BenR,11,1)='Y'  then  rCashier    := 'True'   else  rCashier    := 'False';             
                                      if Copy(BenR,12,1)='Y'  then  rAnnul      := 'True'   else  rAnnul      := 'False';             
                                                       //上段是个人权限
                                      if Copy(Zhu,1,1)='Y'    then  rGSee       := 'True'   else  rGSee       := 'False';              
                                      if Copy(Zhu,2,1)='Y'    then  rGAlter     := 'True'   else  rGAlter     := 'False';               
                                      if Copy(Zhu,3,1)='Y'    then  rGDel       := 'True'   else  rGDel       := 'False';              
                                      if Copy(Zhu,4,1)='Y'    then  rGSanction  := 'True'   else  rGSanction  := 'False';               
                                      if Copy(Zhu,5,1)='Y'    then  rGCancel    := 'True'   else  rGCancel    := 'False';             
                                      if Copy(Zhu,7,1)='Y'    then  rGAnnul     := 'True'   else  rGAnnul     := 'False';             
                                                       //上段是组权限
                                      if Copy(Taz,1,1)='Y'    then  rTGSee      := 'True'   else  rTGSee      := 'False';               
                                      if Copy(Taz,2,1)='Y'    then  rTGAlter    := 'True'   else  rTGAlter    := 'False';              
                                      if Copy(Taz,3,1)='Y'    then  rTGDel      := 'True'   else  rTGDel      := 'False';               
                                      if Copy(Taz,4,1)='Y'    then  rTGSanction := 'True'   else  rTGSanction := 'False';               
                                      if Copy(Taz,5,1)='Y'    then  rTGCancel   := 'True'   else  rTGCancel   := 'False';               
                                      if Copy(Taz,7,1)='Y'    then  rTGAnnul    := 'True'   else  rTGAnnul    := 'False';               
                                                       //上段是他组权限
                                      if Copy(XianD,1,1)='Y'  then  rClient     := 'True'   else  rClient     := 'False';               
                                      if Copy(XianD,3,1)='Y'  then  rWarehouse  := 'True'   else  rWarehouse  := 'False';               
                                    end;                        end;
              end;
end;
end.

Answer 2

完全可以,但是注意几天,string类型在DLL中换成Pchar
如果不换,在调用DLL中的程序在工程引用ShareMem单元,并且放在引用第一位
还有,在DLL调用ADOQuery的时候要初始化CoUninitialize
楼下继续..我暂时只能想到这些!

Answer 3

好像主程序不能引用Dll里的全局变量!?

Answer 4

主程序需要的所有变量，通过函数返回，String类型用PChar替换。其次，改.dpr工程文件，吧program关键字改成library。然后新建一个函数，例如：function CreateDllForm(): BOOL; stdcall; export;
begin
  //将原dpr文件中 begin end.之间的代码剪贴过来，原先的删除。
end;然后加一句：exports
  CreateDllForm;编译，调用CreateDllForm函数即可。

Answer 5

不怎么理解,可不可以写一个完整的主程序和Dll文件,用主程序调用Dll文件;Dll文件如上所述,主程序对应的地方调用.
我确实有点笨,如果愿意可以贴出来,或发我
感激不尽!!

Answer 6

这种情况完全用不着写成dll,只需要做成模板，新开的程序从这里继承即可。想再简单点就是保留下这个工程，做新工程时直接拷贝来用就行了。

Answer 7

我有点不明白,我们公司外购的软件,当需要他们开发什么新的程序时,他们写好之后发过来的全是Dll文件,然后拷到相应的目录下就可以在软件界面中打开;
打开的就是有图形界面和可操作的窗体了,按理说Dll文件只是被调用什么函数与过程之后的,不会有什么图形界面之类的.如果把后缀名直接改成.exe是不能用的;
这是为什么?是通过什么方式实现的?

Answer 8

dll不只是函数或过程，也可以封装窗体的~~

Answer 9

做好一个功能模块，留一个接口（比如dll中的输出函数，可包含窗体），主程序中只要调用该接口就可以了，这与插件的概念很像

Answer 10

楼上的说的对，你最好把窗体也封装到DLL中，省得参数传来传去的麻烦。我想你也可以在DLL中定义函数来返回DLL中全局变量的指针，这样就可以在主窗体中修改和使用DLL中的全局变量了。但是同一DLL是共享内存资源的，所以如果有两个及以上的程序都在用这个DLL就会把数据改乱了，呵呵。

Answer 11

至于在dll中封中窗体的例子你可以在网上找一些比如：http://www.2ccc.com/article.asp?articleid=4043
在google中搜“delphi dll　封装窗体”就能搜到不少。