Delphi 开发快捷功能

NOQC

已于 2024-04-12 22:19:46 修改

阅读量884

点赞数 18

文章标签：开发语言

于 2024-04-12 16:06:49 首次发布

本文链接：https://blog.csdn.net/weixin_55262935/article/details/137683337

版权

1、记录日志

procedure WriteLog;

var
txt: TextFile;

begin
var strFileDir := ExtractFilePath(ParamStr(0)) + 'DataRecord';//文件夹路径
if not DirectoryExists(strFileDir) then//判断是否存在文件夹
ForceDirectories(strFileDir);//没有就创建

strFileDir := strFileDir + '\' + FormatDateTime('yyyy-mm-dd', Now);

if not DirectoryExists(strFileDir) then
ForceDirectories(strFileDir);
var strPath := strFileDir + '\' + FormatDateTime('HH', Now) + '.csv';//按照时间设置文件min

if not FileExists(strPath) then
begin
Assignfile(txt, strPath); //指定文件路径
rewrite(txt);
Writeln(txt, 内容);
end
else
begin
AssignFile(txt, strPath);
Append(txt); //以追加的方式打开文件，指针到尾
end;
Writeln(txt, 内容);

CloseFile(txt) ;//关闭文件

end;

2、批量寻找某类型文件（递归）

procedure Bulk(Filename: string);
var
search: TSearchRec;
aClass: Variant;
ret: Integer;
key: string;
strFile, strname: string;
begin
try
Filename := Filename + '\';
key := Filename + '*.*'; //下级目录未找到递归找直到找到为止
ret := FindFirst(key, faAnyFile, search);
try
while ret = 0 do
begin
if ((Pos('.bin', LowerCase(search.name))) > 0) then //文件后缀名字
begin
listFile.add(FilePath);//添加文件夹名字
end;
if Pos('.', search.Name) = 0 then
Bulk(Filename + search.name);
ret := FindNext(search);
end;
finally
FindClose(search);
end;
except
on E: Exception do
begin
Exit;
end;
end;
end;

3、邮件服务

exe程序根目录下需要引入ssleay32.dll、libeay32.dll

procedure SendEmail(const ASmtpHost, AUsername, APassword, AFrom, ATo, ASubject: string; ABody: Tstrings);
var
IdSMTP: TIdSMTP;
IdMessage: TIdMessage;
ssl: TIdSSLIOHandlerSocketOpenSSL;
Attachment: TIdAttachmentFile;
Attachmentpart: TIdAttachment;
stype: string;
begin
IdSMTP := TIdSMTP.Create(nil);
IdMessage := TIdMessage.Create(nil);

try
ssl := TIdSSLIOHandlerSocketOpenSSL.create(nil);
IdSMTP.IOHandler := ssl;
IdSMTP.Host := ASmtpHost;
IdSMTP.Port := 465; //SMTP端口号
IdSMTP.Username := AUsername;//用户名
IdSMTP.Password := APassword;//密码
IdSMTP.UseTLS := utUseExplicitTLS;
ssl.SSLOptions.Method := sslvTLSv1;
ssl.SSLOptions.Mode := sslmUnassigned;
IdMessage.From.Address := AFrom;//发送地址
IdMessage.Recipients.Add.Address := ATo;接收地址
IdMessage.Subject := ASubject;
try
if SaveFile.Count<>0 then
begin
for var s := 0 to SaveFile.Count-1 do
begin
Attachment := TIdAttachmentFile.Create(IdMessage.MessageParts,SaveFile.Strings[s] );
Attachment.CharSet := 'base64';
stype := ReverseString(Copy(ReverseString(SaveFile.Strings[s]),0
,Pos('.',ReverseString(SaveFile.Strings[s]))-1));
if stype='txt' then
Attachment.ContentType := 'text/plain'
else
if stype='jpg' then
Attachment.ContentType := 'application/x-jpg'
else
if (stype='xlsx') or (stype='xls') then
Attachment.ContentType := 'application/x-xls';//添加文件类型
end;
end;
with TIdText.Create(IdMessage.MessageParts, nil) do
begin
Body.Add('<html><body>');//添加html样式
ContentType := 'text/html; charset=utf-8';
Body.Add('<html><body>');
for var i := 0 to ABody.Count - 1 do
begin
Body.Add('' + ABody.Strings[i] + '');
end;
Body.Add(' ');
for var j := 0 to rzmStyle.Lines.Count - 1 do
begin
if (j=1) or (j=3) or (j=4) or (j=5) or (j=6)or (j=7) or (j=8)then
Body.Add('' + rzmStyle.Lines.Strings[j] + '')
else
if(j=10)then
begin
Body.Add('' + rzmStyle.Lines.Strings[j] + '');
end
else
begin
Body.Add('' + rzmStyle.Lines.Strings[j] + '');
end;
end;
Body.Add('</body></html>）；

end;
IdMessage.ContentType := 'multipart/mixed';
IdMessage.CharSet := 'gb2312';
IdSMTP.Connect;
try
IdSMTP.Authenticate;
IdSMTP.Send(IdMessage);
ShowMessage('Send Success！');
finally
IdSMTP.Disconnect;
end;
except
on e: Exception do
begin
ShowMessage('Send Fail！Resion：' + e.message);
end;
end;

finally
IdMessage.Free;
IdSMTP.Free;

end;
end;

4、如何调用Dos命令

引用单元 ShellApi

拿7Z.dll举例，做文件解压

procedure TZipForm.btn2Click(Sender: TObject);
var
fileSingle,fileAll,FIleOut: string;
params: string;
begin
list.Clear;
fileSingle := '输入文件路径';

fileOut :=‘输出文件路径’;
if (trim(fileSingle)='') and (trim(fileAll)='') then exit;
if (trim(fileSingle)<>'') then
begin
params := 'x ' + trim(fileSingle) + ' -o' + fileOut;
ShellExecute(0, 'open', PWideChar(ExtractFilePath(ParamStr(0))+'7z.exe'),PWideChar(params), nil, 0);
end；
end;

NOQC

关注

18
点赞
踩
7

收藏

觉得还不错? 一键收藏
0
评论
Delphi 开发快捷功能

if ((Pos('.bin', LowerCase(search.name))) > 0) then //文件后缀名字。if not DirectoryExists(strFileDir) then//判断是否存在文件夹。//添加html样式。
复制链接

扫一扫