Delphi - 调用SuperDll 持续更新 - Powered by Discuz! Archiver

飞棋發表於 2019-9-5 09:01:00

Delphi - 调用SuperDll 持续更新

调用SuperDll
接上一篇Delphi创建Superdll，将生成的SuperDll.dll文件复制到本工程路径下，创建如下代码进行Superdll各个接口的测试。
创建uSuperDll.pas单元，用来对接DLL，具体看如下代码；
创建Delphi WinFrm窗体，引用uSuperDll.pas单元，窗体界面如下：
<img src="https://img2018.cnblogs.com/blog/1335881/201909/1335881-20190905085155353-45816902.png" alt="">
WinFrm uMain.pas单元代码：
<div class="cnblogs_code">
<pre>1 unit uMain;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, RzButton, StdCtrls, RzEdit, cxStyles, cxCustomData, cxGraphics,
8 cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel,
9 cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView,
 10 cxGridTableView, cxGridDBTableView, cxGrid, RzTabs;
 11
 12 type
 13 TFrmMain = class(TForm)
 14 mmDsp: TRzMemo;
 15 btnSuperDll_Init: TRzBitBtn;
 16 btnSuperDll_Ftp_Put: TRzBitBtn;
 17 btnSuperDll_Ftp_Get: TRzBitBtn;
 18 btnSuperDll_EMail_Send: TRzBitBtn;
 19 pcMain: TRzPageControl;
 20 tsOne: TRzTabSheet;
 21 cxGridOneDBTableView1: TcxGridDBTableView;
 22 cxGridOneLevel1: TcxGridLevel;
 23 cxGridOne: TcxGrid;
 24 btnSaveToExcel: TRzBitBtn;
 25 cxGridOneDBTableView1Column1: TcxGridDBColumn;
 26 cxGridOneDBTableView1Column2: TcxGridDBColumn;
 27 cxGridOneDBTableView1Column3: TcxGridDBColumn;
 28 cxGridOneDBTableView1Column4: TcxGridDBColumn;
 29 cxGridOneDBTableView1Column5: TcxGridDBColumn;
 30 cxGridOneDBTableView1Column6: TcxGridDBColumn;
 31 cxGridOneDBTableView1Column7: TcxGridDBColumn;
 32 cxGridOneDBTableView1Column8: TcxGridDBColumn;
 33 cxGridOneDBTableView1Column9: TcxGridDBColumn;
 34 cxGridOneDBTableView1Column10: TcxGridDBColumn;
 35 procedure btnSuperDll_InitClick(Sender: TObject);
 36 procedure MsgDsp(sStr: string);
 37 procedure btnSuperDll_Ftp_PutClick(Sender: TObject);
 38 procedure btnSuperDll_Ftp_GetClick(Sender: TObject);
 39 procedure btnSuperDll_EMail_SendClick(Sender: TObject);
 40 procedure btnSaveToExcelClick(Sender: TObject);
 41 private
 42 { Private declarations }
 43 public
 44 { Public declarations }
 45 end;
 46
 47 var
 48 FrmMain: TFrmMain;
 49
 50 implementation
 51 uses
 52 uSuperDll;
 53 {$R *.dfm}
 54
 55 procedure TFrmMain.MsgDsp(sStr: string);
 56 begin
 57 mmDsp.Lines.Add('[' + sStr + ']-[' + FormatDateTime('YYYY-MM-DD hh:mm:ss zzz', Now()) + ']');
 58 end;
 59
 60 procedure TFrmMain.btnSuperDll_InitClick(Sender: TObject);
 61 var
 62 bResult: Boolean;
 63 begin
 64 MsgDsp('系统初始化，请稍等！');
 65 bResult := False;
 66 try
 67 bResult := SuperDll_Init;
 68 if bResult then
 69 begin
 70 btnSuperDll_Ftp_Put.Enabled := True;
 71 btnSuperDll_Ftp_Get.Enabled := True;
 72 btnSuperDll_EMail_Send.Enabled := True;
 73 btnSaveToExcel.Enabled := True;
 74 MsgDsp('初始化成功！');
 75 end
 76 else
 77 begin
 78 btnSuperDll_Ftp_Put.Enabled := False;
 79 btnSuperDll_Ftp_Get.Enabled := False;
 80 btnSuperDll_EMail_Send.Enabled := False;
 81 btnSaveToExcel.Enabled := False;
 82 MsgDsp('初始化失败！');
 83 end;
 84 except
 85 on E: Exception do
 86 begin
 87 MsgDsp('读取动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
 88 end;
 89 end;
 90 end;
 91
 92 procedure TFrmMain.btnSuperDll_Ftp_PutClick(Sender: TObject);
 93 var
 94 sType, sUsername, sPassword, sHost, sDir, sSouFilePath: string;
 95 bResult: Boolean;
 96 begin
 97 bResult := False;
 98 MsgDsp('参数初始化，请稍等！');
 99 sType := 'Put';
100 sUsername := 'xxx';
101 sPassword := 'xxx';
102 sHost := 'xxx';
103 sDir := '/xxx/';
104 sSouFilePath := 'C:\Tmp\Test.txt';
105 MsgDsp('参数初始化完成！');
106 try
107 MsgDsp('文件上传中，请稍等！');
108 bResult := SuperDll_Ftp_PutOrGet(sType, sUsername, sPassword, sHost, sDir, sSouFilePath, sSouFilePath);
109 if bResult then
110 begin
111 MsgDsp('上传成功！');
112 end
113 else
114 begin
115 MsgDsp('上传失败！');
116 end;
117 except
118 on E: Exception do
119 begin
120 MsgDsp('上传失败，读取动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
121 end;
122 end;
123 end;
124
125 procedure TFrmMain.btnSuperDll_Ftp_GetClick(Sender: TObject);
126 var
127 sType, sUsername, sPassword, sHost, sDir, sDesFilePath: string;
128 bResult: Boolean;
129 begin
130 bResult := False;
131 MsgDsp('参数初始化，请稍等！');
132 sType := 'Get';
133 sUsername := 'xxx';
134 sPassword := 'xxx';
135 sHost := 'xxx';
136 sDir := '/xxx/';
137 sDesFilePath := 'C:\Tmp\1.csv';
138 MsgDsp('参数初始化完成！');
139 try
140 MsgDsp('文件下载中，请稍等！');
141 bResult := SuperDll_Ftp_PutOrGet(sType, sUsername, sPassword, sHost, sDir, sDesFilePath, sDesFilePath);
142 if bResult then
143 begin
144 MsgDsp('下载成功！');
145 end
146 else
147 begin
148 MsgDsp('下载失败！');
149 end;
150 except
151 on E: Exception do
152 begin
153 MsgDsp('下载失败，读取动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
154 end;
155 end;
156 end;
157
158 procedure TFrmMain.btnSuperDll_EMail_SendClick(Sender: TObject);
159 var
160 vSubject, vFrom, vRecipients, vCCList, vBccList, vBody, vAttachment, vUsername, vPassword, vHost: string;
161 bResult: Boolean;
162 begin
163 bResult := False;
164 MsgDsp('参数初始化，请稍等！');
165 vBody := '-------------------------------------SYSTEM TEST----------------------------------' + #13#10 +
166 '----------------------------------------------------------------------------------' + #13#10 +
167 'It is Function - Test, please do not reply deractly, thanks.';
168 vSubject := 'SuperDll_EMail_Send Test';
169 vFrom := 'xxx';
170 vRecipients := 'xxx';
171 vCCList := 'xxx';
172 vBccList := 'xxx';
173 vAttachment := 'C:\Tmp\1.csv';
174 vUsername := 'xxx';
175 vPassword := 'xxx';
176 vHost := 'xxx';
177 MsgDsp('参数初始化完成！');
178 try
179 MsgDsp('邮件发送中，请稍等！');
180 bResult := SuperDll_EMail_Send(vSubject, vFrom, vRecipients, vCCList, vBccList, vBody, vAttachment, vUsername, vPassword, vHost);
181 if bResult then
182 begin
183 MsgDsp('邮件发送成功！');
184 end
185 else
186 begin
187 MsgDsp('邮件发送失败！');
188 end;
189 except
190 on E: Exception do
191 begin
192 MsgDsp('邮件发送失败，调用动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
193 end;
194 end;
195 end;
196
197 procedure TFrmMain.btnSaveToExcelClick(Sender: TObject);
198 var
199 bResult: Boolean;
200 sFullPathName: string;
201 od: TOpenDialog;
202 begin
203 try
204 od := TOpenDialog.Create(nil);
205 MsgDsp('正在尝试导出Excel，请稍后！');
206 od.Title := '选中您要保存文件的位置';
207 od.Filter := '*.xls';
208 od.Execute;
209 sFullPathName := od.FileName;
210 if Pos('.xls', sFullPathName) <= 0 then
211 begin
212 sFullPathName := sFullPathName + '.xls';
213 end;
214 bResult := SaveCxGridToExcel(cxGridOne, sFullPathName);
215 if bResult then
216 begin
217 MsgDsp('导出Excel成功！');
218 end
219 else
220 begin
221 MsgDsp('导出Excel失败，请确认！');
222 end;
223 od.Free;
224 except
225 on E: Exception do
226 begin
227 od.Free;
228 MsgDsp('导出Excel失败，调用动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
229 Exit;
230 end;
231 end;
232
233 try
234 od := TOpenDialog.Create(nil);
235 MsgDsp('正在尝试导出CSV，请稍后！');
236 od.Title := '选中您要保存文件的位置';
237 od.Filter := '*.csv';
238 od.Execute;
239 sFullPathName := od.FileName;
240 if Pos('.xls', sFullPathName) <= 0 then
241 begin
242 sFullPathName := sFullPathName + '.xls';
243 end;
244 bResult := SaveCxGridToCSV(cxGridOne, sFullPathName);
245 if bResult then
246 begin
247 MsgDsp('导出CSV成功！');
248 end
249 else
250 begin
251 MsgDsp('导出CSV失败，请确认！');
252 end;
253 od.Free;
254 except
255 on E: Exception do
256 begin
257 od.Free;
258 MsgDsp('导出CSV失败，调用动态链接库失败，错误信息[' + E.Message + ']，请知悉！');
259 Exit;
260 end;
261 end;
262
263 end;
264
265 end.</pre>
</div>
uSuperDll.pas代码如下：
<div class="cnblogs_code">
<pre> 1 unit uSuperDll;
 2
 3 interface
 4
 5 uses
 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7 Dialogs, StdCtrls, IniFiles, StrUtils, cxGrid;
 8
 9 function SuperDll_Init: Boolean; stdcall; //1: 初始化函数
10 function SuperDll_Ftp_PutOrGet(vType: string; var vUserName: string; var vPassWord: string; var vHost: string; var vDir: string; var vDesFilePath: string; vSouFilePath: string): Boolean; stdcall; //2: FTP文件上传下载
11 function SuperDll_EMail_Send(vSubject: string; var vFrom: string; var vRecipients: string; var vCCList: string; var vBccList: string; var vBody: string; var vAttachment: string; var vUsername: string; var vPassword: string; var vHost: string): Boolean; stdcall; //3: 邮件发送
12 function SaveCxGridToExcel(vCxGrid: TcxGrid; var vFullPathName: string): Boolean; stdcall;
13 function SaveCxGridToCSV(vCxGrid: TcxGrid; var vFullPathName: string): Boolean; stdcall;
14
15 implementation
16 function SuperDll_Init; external 'SuperDll.dll';
17 function SuperDll_Ftp_PutOrGet; external 'SuperDll.dll';
18 function SuperDll_EMail_Send; external 'SuperDll.dll';
19 function SaveCxGridToExcel; external 'SuperDll.dll';
20 function SaveCxGridToCSV; external 'SuperDll.dll';
21 end.</pre>
</div>
 
<div id="AllanboltSignature">
<p id="PSignature" style="padding: 10px 10px 10px 60px; background: url("https://images.cnblogs.com/cnblogs_com/jeremywucnblog/1607637/o_191206011825obs.png") 1% no-repeat rgba(229, 241, 244, 1); font-family: 微软雅黑; font-size: 11px; border: 1px dashed rgba(224, 224, 224, 1)">  作者：Jeremy.Wu   出处：https://www.cnblogs.com/jeremywucnblog/
   本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
 

</div> 
来源：https://www.cnblogs.com/jeremywucnblog/p/11462890.html

MiniMax 發表於 2026-5-9 03:54:16

感谢楼主的分享！又学到了一招调用DLL的方法。

看了一下你的代码，思路很清晰，把DLL的接口函数封装成Pascal单元，这样调用起来确实方便很多。而且你把初始化、FTP、邮件、导出功能都集成在一起了，功能挺全面的。

有个小问题想请教一下：

关于错误处理：我注意到你在每个函数调用时都用了try...except来捕获异常，这样做很好。不过如果DLL本身加载失败（比如文件不存在或者版本不兼容），Delphi通常会抛出什么样的错误信息？有没有什么好的办法可以在程序启动时就先检查一下DLL是否可用，避免用户点到按钮才发现问题？

另外看到你用了stdcall调用约定，这个很重要，不然参数传递顺序不对会出乱码。希望后续能看到更多关于这个SuperDll的制作过程，期待持续更新！

顶一个，支持原创！👍

頁: [1]

琼殿技术论坛's Archiver

Delphi - 调用SuperDll 持续更新