吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 1494|回复: 34
收起左侧

[其他原创] 监测目录下新增DOCX文件,自动转化为PDF(Delphi源码)

  [复制链接]
/bq 发表于 2025-1-18 15:47
本帖最后由 /bq 于 2025-3-2 21:49 编辑

20250302更新
1、修改为数据库存储文件。
2、修改文件处理时未退出当前编辑文档,引起文件打开时提示文件已经使用问题。
3、添加目录右键直接添加转换任务,实现旧文档的批量转换工作。首次运行程序后自动添加系统目录菜单右键“文档转换工具”菜单。
4、主界面右键可对已经转换失败文件重新启动转换任务,控制所有所有文档或者所有错误文档。
5、提供一个简单的页面进行在线提交转换下载功能。
6、通知栏菜单添加重启服务,下载OFFICE网站地址,打开测试转换页面功能。更新及设置功能正在实现。
7、主窗口右键添加监测目录后可实现对指定目录的监控文件添加操作,实现文档的转换功能。

主要功能代码
[Delphi] 纯文本查看 复制代码
   文件重复启动时通过消息通知已经运行的程序      var s: ansistring;
      var Data: tagCOPYDATASTRUCT;
      var pBuf: PansiChar;
      if ParamCount > 0 then
      begin
        for i := 1 to ParamCount do
          s := s + ',' + ParamStr(i);
        Delete(s, 1, 1);
      end;
      GetMem(pBuf, Length(s) + 1);
      ZeroMemory(pBuf, Length(s) + 1);
      StrPCopy(pBuf, s);
      Data.cbData := Length(s);
      Data.dwData := Length(s);
      Data.lpData := pBuf;
      xlog('发送文件目录处理命令:' + s);
      SendMessage(h, WM_COPYDATA, 0, Integer(@Data));


[Delphi] 纯文本查看 复制代码
 
 wdoc := wapp.Documents.Open(FieldByName('fileName').asString,
          False, True); //文件名,不存历史打开,只读打开
wdoc.saveas(ChangeFileExt(FieldByName('fileName').asString,
          '.' + FieldByName('fileDes').asString), 17);
        wdoc.Close(False);  //退出当前打开文档


网页转换界面

网页转换界面



通知栏菜单

通知栏菜单


系统目录右键菜单

系统目录右键菜单


主界面

主界面


docsrv_bin.7z (2 MB, 下载次数: 2)

2025019更新
1、自动监测本程序目录及子目录文件添加操作
2、修改监测到修改立即进行转换为监测完添加文件转化队列,防止转换过程中无法监测到新文件的问题
3、最小化隐藏主窗口,双击右下图标显示。关闭窗口自动隐藏。

核心代码,使用qdac的线程队列,
[Delphi] 纯文本查看 复制代码
var
  wdoc: Variant;
begin
//listview
  AJob.Worker.ComNeeded; //保证在线程中初始化COM服务
  with FrmMain.lv.Items.Item[IntPtr(AJob.Data)] do
  begin
    try
      SubItems.Strings[2] := '准备转换';

//COM方式调用WORD,进行DOC到PDF转换
      wdoc := CreateOleObject('Word.Document');
      wapp.Documents.Open(SubItems.Strings[0]);
      wdoc := wapp.ActiveDocument;
      wdoc.saveas(ChangeFileExt(SubItems.Strings[0], '.pdf'), 17);
//转换完成后退出word,可能存在无法退出的清空,后面会添加
杀进程功能
wapp.quit;

      SubItems.Strings[2] := '已经转换';
    except
      on E: Exception do
      begin
        SubItems.Strings[2] := '转换失败';
        XLog(e.Message);
      end;
    end;
  end;
end;








免费评分

参与人数 5吾爱币 +10 热心值 +5 收起 理由
苏紫方璇 + 7 + 1 欢迎分析讨论交流,吾爱破解论坛有你更精彩!
wsasecy + 1 + 1 谢谢@Thanks!
zylz9941 + 1 + 1 谢谢@Thanks!
aahong + 1 谢谢@Thanks!
lizooo + 1 + 1 谢谢@Thanks!

查看全部评分

本帖被以下淘专辑推荐:

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

xeonfeng 发表于 2025-1-19 21:15
这个不需要第三方插件支持吗?默认用office的ocx?
 楼主| /bq 发表于 2025-1-22 08:31
原始人 发表于 2025-1-21 21:00
检测目录的代码能不能一并发布出来

使用CnFileSystemWatcher ,是CnVCL中的一个控件,监测多个目录就是使用 CnFileSystemWatcher数组,onchange方法调用同一个
[Delphi] 纯文本查看 复制代码
procedure TDmSys.fswChange(Sender: TObject; FileOperation: TFileOperation; const
  FileName1, FileName2: string);
begin
  with FrmMain, lv, Items do
    if not FileName1.StartsWith('~') then
      with Add do
      begin
        Caption := IntToStr(Items.Count);
        SubItems.Add(TCnFileSystemWatcher(Sender).WatchedDir + FileName1);
        if FileOperation = foAdded then
        begin
          SubItems.Add('添加');
          Workers.post(DoDoc2PdfJob, Pointer(Items.Count - 1));
        end
        else if FileOperation = foModified then
        begin
          SubItems.Add('修改');
          Workers.post(DoDoc2PdfJob, Pointer(Items.Count - 1));
        end
        else if FileOperation = foRemoved then
          SubItems.Add('删除');

        SubItems.Add('未处理');
        SubItems.Add(Formatdatetime('yyyy-mm-dd hh:nn:ss', Now));

      end;
end;
lizooo 发表于 2025-1-18 15:57
ljlwlgjgwy1 发表于 2025-1-18 16:09
感谢分享
youngx1 发表于 2025-1-18 16:16
感谢大佬分享
aahong 发表于 2025-1-18 16:44
嗯,谢谢分享,先收藏~
zhengzhenhui945 发表于 2025-1-18 16:57
能不能反过来pdf转DOC文件
zylz9941 发表于 2025-1-18 17:14
谢谢楼主的分享
 楼主| /bq 发表于 2025-1-18 17:26
zhengzhenhui945 发表于 2025-1-18 16:57
能不能反过来pdf转DOC文件

pdf转word需要3方库支持,以后可以考虑集成python
wwwuser 发表于 2025-1-18 17:45
感谢提供,实用有效!
cwp118 发表于 2025-1-18 18:35
感谢大佬分享
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2025-4-20 02:16

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表