Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 944

Раздел: Delphi » Взаимодействие с Windows
/ вопрос открыт /

Здравствуйте, эксперты! Подскажите пожалуйста, как можно определить, что началось копирование или перемещение данных в Windows? Можно ли определить что, откуда и куда копируется или перемещается?

alone Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: alone (статус: Посетитель)
Вопрос отправлен: 28 сентября 2007, 23:02
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Грег Леонов

Доброе утро, Олег!

Тут однозначно нужно использовать WinAPI.
А вообще считаю что отследить "все" записи в Windows - ресурсоемкая операция. Т.к. Windows постоянно что-то пишет на диск(правда постоянно новые файлы не создает).

http://download.sysinternals.com/Files/Filemon.zip - прога чтоб отследить все операции с файловой системой в ОС.

Я сам в WinAPI не очень хорошо разбираюсь, но поюзав google, нашел код реализации поиска изменений в файловой системе с помощью WinAPI.

Приложение:
  1. program file_seeker;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6. SysUtils, windows, tintlist;
  7.  
  8. type
  9. NTStatus = cardinal;
  10. PVOID = pointer;
  11. USHORT = WORD;
  12. UCHAR = byte;
  13. PWSTR = PWideChar;
  14.  
  15.  
  16. STATUS_SUCCESS = NTStatus($00000000);
  17. STATUS_ACCESS_DENIED = NTStatus($C0000022);
  18. STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004);
  19. SEVERITY_ERROR = NTStatus($C0000000);
  20.  
  21. const SystemHandleInformation = 16;
  22. OB_TYPE_FILE = 28;
  23.  
  24. type
  25. PClientID = ^TClientID;
  26. TClientID = packed record
  27. UniqueProcess:cardinal;
  28. UniqueThread:cardinal;
  29. end;
  30.  
  31. PUnicodeString = ^TUnicodeString;
  32. TUnicodeString = packed record
  33. Length: Word;
  34. MaximumLength: Word;
  35. Buffer: PWideChar;
  36. end;
  37.  
  38. PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
  39. SYSTEM_HANDLE_INFORMATION = packed record
  40. ProcessId: dword;
  41. ObjectTypeNumber: byte;
  42. Flags: byte;
  43. Handle: word;
  44. pObject: pointer;
  45. GrantedAccess: dword;
  46. end;
  47.  
  48. PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
  49. SYSTEM_HANDLE_INFORMATION_EX = packed record
  50. NumberOfHandles: dword;
  51. Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
  52. end;
  53.  
  54. Function ZwQuerySystemInformation(ASystemInformationClass: dword;
  55. ASystemInformation: Pointer;
  56. ASystemInformationLength: dword;
  57. AReturnLength:PCardinal): NTStatus;
  58. stdcall;external 'ntdll.dll';
  59.  
  60.  
  61. function EnablePrivilegeEx(Process: dword; lpPrivilegeName: PChar):Boolean;
  62. var
  63. hToken: dword;
  64. NameValue: Int64;
  65. tkp: TOKEN_PRIVILEGES;
  66. ReturnLength: dword;
  67. begin
  68. Result:=false;
  69.  
  70. OpenProcessToken(Process, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
  71.  
  72. if not LookupPrivilegeValue(nil, lpPrivilegeName, NameValue) then
  73. begin
  74. CloseHandle(hToken);
  75. exit;
  76. end;
  77. tkp.PrivilegeCount := 1;
  78. tkp.Privileges[0].Luid := NameValue;
  79. tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  80.  
  81. AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES), tkp, ReturnLength);
  82. if GetLastError() <> ERROR_SUCCESS then
  83. begin
  84. CloseHandle(hToken);
  85. exit;
  86. end;
  87. Result:=true;
  88. CloseHandle(hToken);
  89. end;
  90.  
  91.  
  92. function EnablePrivilege(lpPrivilegeName: PChar):Boolean;
  93. begin
  94. Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, lpPrivilegeName);
  95. end;
  96.  
  97.  
  98.  
  99. function EnableDebugPrivilegeEx(Process: dword):Boolean;
  100. begin
  101. Result := EnablePrivilegeEx(Process, 'SeDebugPrivilege');
  102. end;
  103.  
  104.  
  105. function EnableDebugPrivilege():Boolean;
  106. begin
  107. Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, 'SeDebugPrivilege');
  108. end;
  109.  
  110.  
  111. Function GetInfoTable(ATableType:dword):Pointer;
  112. var
  113. mSize: dword;
  114. mPtr: pointer;
  115. St: NTStatus;
  116. begin
  117. Result := nil;
  118.  
  119. repeat
  120. mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  121. if mPtr = nil then Exit;
  122. St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil);
  123. if St = STATUS_INFO_LENGTH_MISMATCH then
  124.  
  125. VirtualFree(mPtr, 0, MEM_RELEASE);
  126. mSize := mSize * 2;
  127. end;
  128. until St <> STATUS_INFO_LENGTH_MISMATCH;
  129. if St = STATUS_SUCCESS
  130. then Result := mPtr
  131. else VirtualFree(mPtr, 0, MEM_RELEASE);
  132. end;
  133.  
  134. var
  135. HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX;
  136. r: integer;
  137. hProcess, tHandle: dword;
  138. file_h: tintegerlist;
  139. begin
  140.  
  141. file_h := tintegerlist.Create;
  142.  
  143. EnableDebugPrivilege();
  144. HandlesInfo := GetInfoTable(SystemHandleInformation);
  145. for r := 0 to HandlesInfo^.NumberOfHandles do
  146. if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then
  147. begin
  148. file_h.Add(HandlesInfo^.Information[r].Handle);
  149. end;
  150.  
  151. VirtualFree(HandlesInfo, 0, MEM_RELEASE);
  152.  
  153.  
  154. while true do
  155. begin
  156. Sleep(200);
  157.  
  158. HandlesInfo := GetInfoTable(SystemHandleInformation);
  159. for r := 0 to HandlesInfo^.NumberOfHandles do
  160. if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then
  161. begin
  162. if file_h.IndexOf(HandlesInfo^.Information[r].Handle)=-1 then
  163. begin
  164. file_h.Add(HandlesInfo^.Information[r].Handle);
  165. writeln(HandlesInfo^.Information[r].Handle, ' - added a file handle');
  166. end;
  167. end;
  168.  
  169. VirtualFree(HandlesInfo, 0, MEM_RELEASE);
  170. end;
  171.  
  172. readln;
  173.  
  174. end.
  175.  
  176.  


Ответ отправил: Грег Леонов (статус: 1-ый класс)
Время отправки: 29 сентября 2007, 00:47
Оценка за ответ: 4

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Гадлевский Олег Вячеславович!
Сам я не пробовал, но пару примеров нашел. См. в приложении.

Приложение:
  1.  
  2.  
  3. unit Unit1;
  4.  
  5. {cDrkb v.3(2007): www.drkb.ru}
  6.  
  7. interface
  8.  
  9. uses
  10.  
  11. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  12. Dialogs, StdCtrls;
  13.  
  14. type
  15.  
  16. PFileNotifyInformation = ^TFileNotifyInformation;
  17. TFileNotifyInformation = record
  18. NextEntryOffset: DWORD;
  19. Action: DWORD;
  20. FileNameLength: DWORD;
  21. FileName: array [0..MAX_PATH - 1] of WideChar;
  22. end;
  23.  
  24. TForm1 = class(TForm)
  25. Memo1: TMemo;
  26. procedure FormCreate(Sender: TObject);
  27. end;
  28.  
  29. var
  30.  
  31. Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.dfm}
  36.  
  37. procedure TForm1.FormCreate(Sender: TObject);
  38. const
  39. Filter = FILE_NOTIFY_CHANGE_FILE_NAME or
  40. FILE_NOTIFY_CHANGE_DIR_NAME or
  41. FILE_NOTIFY_CHANGE_ATTRIBUTES or
  42. FILE_NOTIFY_CHANGE_SIZE or
  43. FILE_NOTIFY_CHANGE_LAST_WRITE or
  44. FILE_NOTIFY_CHANGE_LAST_ACCESS or
  45. FILE_NOTIFY_CHANGE_CREATION or
  46. FILE_NOTIFY_CHANGE_SECURITY;
  47. var
  48.  
  49. Dir: THandle;
  50. Notify: TFileNotifyInformation;
  51. BytesReturned: DWORD;
  52.  
  53. begin
  54. Dir := CreateFile('d:', GENERIC_READ,
  55. FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
  56. nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  57. if Dir <> INVALID_HANDLE_VALUE then
  58. try
  59. if not ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation),
  60. False, Filter, @BytesReturned, nil, nil) then
  61. raise Exception.Create(SysErrorMessage(GetLastError))
  62. else
  63. case Notify.Action of
  64. FILE_ACTION_ADDED: ShowMessage('New file' + Notify.FileName);
  65. FILE_ACTION_REMOVED: ShowMessage('Delete file' + Notify.FileName);
  66. FILE_ACTION_MODIFIED: ShowMessage('Modify file' + Notify.FileName);
  67. FILE_ACTION_RENAMED_OLD_NAME: ShowMessage('Old Name file' + Notify.FileName);
  68. FILE_ACTION_RENAMED_NEW_NAME: ShowMessage('New Name file' + Notify.FileName);
  69. end;
  70. finally
  71. CloseHandle(Dir);
  72. end;
  73. end;
  74. end.
  75.  
  76. ====================================================
  77.  
  78.  
  79.  
  80. unit wfsU;
  81.  
  82. interface
  83.  
  84. type
  85.  
  86.  
  87.  
  88. PInfoCallback = ^TInfoCallback;
  89. TInfoCallback = record
  90.  
  91.  
  92.  
  93.  
  94. end;
  95.  
  96.  
  97.  
  98. TWatchFileSystemCallback = procedure (pInfo: TInfoCallback);
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106. procedure StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);
  107.  
  108.  
  109.  
  110. procedure StopWatch;
  111.  
  112. implementation
  113.  
  114. uses
  115.  
  116. Classes, Windows, SysUtils;
  117.  
  118. const
  119.  
  120. FILE_LIST_DIRECTORY = $0001;
  121.  
  122. type
  123.  
  124. PFileNotifyInformation = ^TFileNotifyInformation;
  125. TFileNotifyInformation = record
  126. NextEntryOffset : DWORD;
  127. Action : DWORD;
  128. FileNameLength : DWORD;
  129. FileName : array[0..0] of WideChar;
  130. end;
  131.  
  132. WFSError = class(Exception);
  133.  
  134. TWFS = class(TThread)
  135. private
  136. FName : string;
  137. FFilter : Cardinal;
  138. FSubTree : boolean;
  139. FInfoCallback : TWatchFileSystemCallback;
  140. FWatchHandle : THandle;
  141. FWatchBuf : array[0..4096] of Byte;
  142. FOverLapp : TOverlapped;
  143. FPOverLapp : POverlapped;
  144. FBytesWritte : DWORD;
  145. FCompletionPort : THandle;
  146. FNumBytes : Cardinal;
  147. FOldFileName : string;
  148. function CreateDirHandle(aDir: string): THandle;
  149. procedure WatchEvent;
  150. procedure HandleEvent;
  151. protected
  152. procedure Execute; override;
  153. public
  154. constructor Create(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);
  155. destructor Destroy; override;
  156. end;
  157.  
  158.  
  159. var
  160.  
  161. WFS : TWFS;
  162.  
  163. procedure StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);
  164. begin
  165. WFS:=TWFS.Create(pName, pFilter, pSubTree, pInfoCallback);
  166. end;
  167.  
  168. procedure StopWatch;
  169. var
  170. Temp : TWFS;
  171. begin
  172. if Assigned(WFS) then
  173. begin
  174. PostQueuedCompletionStatus(WFS.FCompletionPort, 0, 0, nil);
  175. Temp := WFS;
  176. WFS:=nil;
  177. Temp.Terminate;
  178. end;
  179. end;
  180.  
  181. constructor TWFS.Create(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);
  182. begin
  183. inherited Create(True);
  184. FreeOnTerminate:=True;
  185. FName:=IncludeTrailingBackslash(pName);
  186. FFilter:=pFilter;
  187. FSubTree:=pSubTree;
  188. FOldFileName:=EmptyStr;
  189. ZeroMemory(@FOverLapp, SizeOf(TOverLapped));
  190. FPOverLapp:=@FOverLapp;
  191. ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
  192. FInfoCallback:=pInfoCallback;
  193. Resume
  194. end;
  195.  
  196. destructor TWFS.Destroy;
  197. begin
  198. PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);
  199. CloseHandle(FWatchHandle);
  200. FWatchHandle:=0;
  201. CloseHandle(FCompletionPort);
  202. FCompletionPort:=0;
  203. inherited Destroy;
  204. end;
  205.  
  206. function TWFS.CreateDirHandle(aDir: string): THandle;
  207. begin
  208. Result:=CreateFile(PChar(aDir), FILE_LIST_DIRECTORY, FILE_SHARE_READ+FILE_SHARE_DELETE+FILE_SHARE_WRITE,
  209. nil,OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
  210. end;
  211.  
  212. procedure TWFS.Execute;
  213. begin
  214. FWatchHandle:=CreateDirHandle(FName);
  215. WatchEvent;
  216. end;
  217.  
  218. procedure TWFS.HandleEvent;
  219. var
  220. FileNotifyInfo : PFileNotifyInformation;
  221. InfoCallback : TInfoCallback;
  222. Offset : Longint;
  223. begin
  224. Pointer(FileNotifyInfo) := @FWatchBuf[0];
  225. repeat
  226. Offset:=FileNotifyInfo^.NextEntryOffset;
  227. InfoCallback.FAction:=FileNotifyInfo^.Action;
  228. InfoCallback.FDrive:=FName;
  229. SetString(InfoCallback.FNewFileName,FileNotifyInfo^.FileName,FileNotifyInfo^.FileNameLength);
  230. InfoCallback.FNewFileName:=Trim(InfoCallback.FNewFileName);
  231. case FileNotifyInfo^.Action of
  232. FILE_ACTION_RENAMED_OLD_NAME: FOldFileName:=Trim(WideCharToString(@(FileNotifyInfo^.FileName[0])));
  233. FILE_ACTION_RENAMED_NEW_NAME: InfoCallback.FOldFileName:=FOldFileName;
  234. end;
  235. FInfoCallback(InfoCallback);
  236. PChar(FileNotifyInfo):=PChar(FileNotifyInfo)+Offset;
  237. until (Offset=0) or Terminated;
  238. end;
  239.  
  240. procedure TWFS.WatchEvent;
  241. var
  242. CompletionKey: Cardinal;
  243. begin
  244. FCompletionPort:=CreateIoCompletionPort(FWatchHandle, 0, Longint(pointer(self)), 0);
  245. ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
  246. if not ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree,
  247. FFilter, @FBytesWritte, @FOverLapp, nil) then
  248. begin
  249. raise WFSError.Create(SysErrorMessage(GetLastError));
  250. Terminate;
  251. end else
  252. begin
  253. while not Terminated do
  254. begin
  255. GetQueuedCompletionStatus(FCompletionPort, FNumBytes, CompletionKey, FPOverLapp, INFINITE);
  256. if CompletionKey<>0 then
  257. begin
  258. Synchronize(HandleEvent);
  259. ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
  260. FBytesWritte:=0;
  261. ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree, FFilter,
  262. @FBytesWritte, @FOverLapp, nil);
  263. end else Terminate;
  264. end
  265. end
  266. end;
  267.  
  268. end.
  269.  
  270.  
  271.  
  272.  
  273. unit Unit1;
  274. interface
  275. uses
  276.  
  277. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  278.  
  279. Dialogs, StdCtrls;
  280.  
  281. type
  282.  
  283. TForm1 = class(TForm)
  284. Memo1: TMemo;
  285. procedure FormCreate(Sender: TObject);
  286. procedure FormDestroy(Sender: TObject);
  287. private
  288. { Private declarations }
  289. public
  290. { Public declarations }
  291. end;
  292.  
  293. var
  294.  
  295. Form1: TForm1;
  296.  
  297. implementation
  298.  
  299. {$R *.dfm}
  300.  
  301. uses wfsU;
  302.  
  303. procedure MyInfoCallback(pInfo: TInfoCallback);
  304. const
  305.  
  306. begin
  307. case pInfo.FAction of
  308.  
  309. [pInfo.FDrive+pInfo.FOldFileName,pInfo.FDrive+pInfo.FNewFileName]));
  310. else
  311. if pInfo.FAction<FILE_ACTION_RENAMED_OLD_NAME then
  312. Form1.Memo1.Lines.Add(Format(Action[pInfo.Faction], [pInfo.FDrive+pInfo.FNewFileName]));
  313. end;
  314. end;
  315.  
  316. procedure TForm1.FormCreate(Sender: TObject);
  317. begin
  318.  
  319. StartWatch('C:', FILE_NOTIFY_CHANGE_DIR_NAME, True, @MyInfoCallback);
  320. end;
  321.  
  322. procedure TForm1.FormDestroy(Sender: TObject);
  323. begin
  324. StopWatch
  325. end;
  326.  
  327. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 1 октября 2007, 15:50


Мини-форум вопроса

Всего сообщений: 1; последнее сообщение — 29 сентября 2007, 00:49; участников в обсуждении: 1.
Грег Леонов

Грег Леонов (статус: 1-ый класс), 29 сентября 2007, 00:49 [#1]:

Код скопировался неудачно, выдели его и вставь в блокнот, легче прочесть будет. юзай ctrl + a, ctrl + c, ctrl + v

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:15
Выполнено за 0.02 сек.