Можно так (ВЕЛОСИПЕД):
приложение
_action.exe
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
unit _actionUnit1;
//==============================================================================
interface
//==============================================================================
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, FileCtrl, IniFiles;
//==============================================================================
type
TForm1 = class (TForm)
Timer1: TTimer;
flbList: TFileListBox;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end ;
//==============================================================================
var
Form1: TForm1;
my_cmd : string ;
//==============================================================================
implementation
//==============================================================================
{$R *.dfm}
//==============================================================================
function RunMyAppHidden(my_app : string ; my_wait : bool) : bool;
var
si : TStartupInfo;
pi : TProcessInformation;
begin
Result := false;
try
ZeroMemory(@si,SizeOf(si));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
if CreateProcess( nil ,PChar(my_app), nil , nil ,False, 0 , nil , nil ,si,pi)=true then Result := true;
try CloseHandle(pi.hThread); except ; end ;
if my_wait = true then WaitForSingleObject(pi.hProcess, INFINITE);
try CloseHandle(pi.hProcess); except ; end ;
except
Result := false;
end ;
end ;
//==============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
try
with TIniFile.Create(ExtractFilePath(ParamStr( 0 )) + '_action.ini') do
try
flbList.Directory := ReadString('GeneralOptions','DirectoryToMonitor','c:\');
flbList.Mask := ReadString('GeneralOptions','FileMask','*.*');
my_cmd := ExtractFilePath(ParamStr( 0 )) + ReadString('GeneralOptions','ActionToTake','_actionbat.bat');
Timer1.Interval := ReadInteger('GeneralOptions','TimerInterval', 1000 );
finally
Free;
end ;
except
;
end ;
end ;
//==============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
var
my_tmp, my_ind : integer;
begin
flbList.Refresh;
flbList.Update;
if flbList.Count > 0 then
try
my_tmp := Timer1.Interval;
Timer1.Interval := 0 ;
while flbList.Count > 0 do
try
//ShowMessage(my_cmd + ' ' + '"' + flbList.Directory + flbList.Items[0] + '"');
RunMyAppHidden(my_cmd + ' ' + '"' + flbList.Directory + flbList.Items[ 0 ] + '"',true);
try DeleteFile(flbList.Directory + flbList.Items[ 0 ]); except ; end ;
flbList.Refresh;
flbList.Update;
except
;
end ;
Timer1.Interval := my_tmp;
except
;
end ;
end ;
//==============================================================================
end .
файл настройки
_action.ini
1.
2.
3.
4.
[GeneralOptions]
TimerInterval= 1000
DirectoryToMonitor=c:\
FileMask=*.tif
ActionToTake=_actionbat.bat
файл действий
_actionbat.bat
1.
"C:\Program Files\ACD Systems\ACDSee\acdsee.exe" /p! % 1
copy % 1 c:\tmp\
Работает все так: запускаете _action.exe, она мониторит каталог, указанный в параметре DirectoryToMonitor файла _action.ini, на предмет наличия файлов типа, указанного в параметре FileMask, с интервалом TimerInterval, и если такие файлы есть, то:
1) запускает для каждого из файлов батник _actionfile.bat (или любой, указанный в параметре ActionToTake, но расположенный в той же программной папке), имя каждого из файлов передается как параметр батнику, из батника доступен как %1
2) удаляет файл (поэтому если файл нужен, то его копирование в другой каталог пишется в батнике)
У меня работает. Могу выслать и ехе это велосипеда.
... и так пока не опустошит папку...
