Delphi

调用SuperDll

接上一篇Delphi创建Superdll，将生成的SuperDll.dll文件复制到本工程路径下，创建如下代码进行Superdll各个接口的测试。

创建uSuperDll.pas单元，用来对接DLL，具体看如下代码；

创建Delphi WinFrm窗体，引用uSuperDll.pas单元，窗体界面如下：

WinFrm uMain.pas单元代码：

  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:TmpTest.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:Tmp1.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 - [SuperDll_EMail_Send] 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:Tmp1.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.

uSuperDll.pas代码如下：

 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.

作者：Jeremy.Wu
出处：https://www.cnblogs.com/jeremywucnblog/
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。

相关阅读:
多重背包
 Nginx HTTP负载均衡/反向代理的相关参数测试
 提升磁盘IO性能的几个技巧
 优化HyperV的5个技巧
 Nginx负载均衡
 Linux服务器的优化
 服务器选型事项
 varnish集群
 解决Linux中出现Too many open files
nginx timeout 配置全局timeout 局部timeout web timeout
原文地址：https://www.cnblogs.com/jeremywucnblog/p/11462890.html