root/trunk/ExtraFileUtils.pas

Revision 17, 29.1 kB (checked in by sagrer, 1 year ago)

Мелкие фиксы - вытащено исправление бага в ExtraFileUtils?.pas по поводу CopyDirectory? и поправлен crc_32.pas для компиллябельности в билдере.

  • Property svnmailer:content-charset set to cp1251
Line 
1 ///////////////////////////////////////////////////////////
2 //                     ExtraFileUtils                    //
3 //        Ìîäóëü ñ ñàìîïàëüíûìè ôóíêöèÿìè è ïðî÷èì       //
4 //                  äëÿ ðàáîòû ñ ôàéëàìè.                //
5 //             Copyright (C) 2007 Gipat Group            //
6 //              Ðàñïðîñòðàíÿåòñÿ íà óñëîâèÿõ             //
7 //                      LGPL v2.1                        //
8 //                                                       //
9 //                  www.gipatgroup.org                   //
10 ///////////////////////////////////////////////////////////
11
12 //Ê ðàáîòå íàä äàííûì ôàéëîì ïðèëîæèëè ðóêè, íîãè.... êîðî÷å àôôòàðû:
13 // 1) Immortal (immortalGAD@rambler.ru)
14 // 2) Sagrer (sagrer@yandex.ru)
15
16 ////////////////////////////////////////////////////////////////////////
17
18 unit ExtraFileUtils;
19
20 {$IFDEF FPC}
21   {$mode objfpc}
22 {$ENDIF FPC}
23
24 {$H+}
25
26 interface
27
28 uses
29   windows, Classes, SysUtils,
30   {$IFDEF LCL} FileUtil, {$ELSE} CodeFromLCL, StrUtils, {$ENDIF LCL}
31   ExtraFunctions, syncobjs;
32
33 const
34 // Ðàçìåð áóôôåðà, êîòîðûé áóäåò èñïîëüçîâàòñüÿ äëÿ êîïèðîâàíèÿ ôàéëîâ
35   FILECOPY_BUFFER_SIZE = 81920;
36 // Íåðåàëüíîå çíà÷åíèå àòòðèáóòà
37   INVALID_SYSFILE_ATTR :LongInt = -1;
38  
39 // âîçðâðàùàåìûå çíà÷åíèÿ
40   resOk = 0;
41   resParametersError = 1;
42 /////////////////////////
43  
44 type
45 // òàêè ïîêà òîëüêî äëÿ âíóòðåííåãî ïîëüçîâàíèÿ.
46   IOException = class(Exception) end;
47   TFileSystemIterator = class;
48  
49 ////////////////////////////////////////////////////////////////////////////////
50 // Ïðîòîòèï ïðîöåäóðû, äëÿ èíôîðìèðîâàíèÿ î õîäå êîïèðîâàíèÿ
51   TCopyFileProgressCallback = procedure(const current, total :Int64) of object;
52 // Ïðîòîòèï ïðîöåäóðû, äëÿ èíôîðìèðîâàíèÿ î çàâåðøåíèè
53   TCopyFileFinishCallback   = procedure(const resultt :Boolean) of object;
54
55 // êëàññ äëÿ àñèíõðîííîãî êîïèðîâàíèÿ ôàéëà.
56   TCopyFileThread = class (TThread)
57     private
58       curLock, totalLock :TCriticalSection;
59       _current, _total :Int64;
60     protected
61       procedure Execute; override;
62       function  GetTotal   :Int64;
63       procedure SetTotal  (const value :Int64);
64       function  GetCurrent :Int64;
65       procedure SetCurrent(const value :Int64);
66     public
67       // ðåçóëüòàò îïåðàöèè
68       CopyResult :Boolean;
69       CopyFileProgress :TCopyFileProgressCallback;
70       CopyFileFinish   :TCopyFileFinishCallback;
71       SourceFilePath   :AnsiString;
72       DestFilePath     :AnsiString;
73       OverwriteExists  :Boolean;  // ïåðåïèñûâàòü ôàéë , åñëè óæå ñóùåñòâóåò
74       property Total   :Int64 read GetTotal;
75       property Current :Int64 read GetCurrent;
76
77       //Êîíñòðóêòîðû-äåñòðóêòîðû.
78       constructor Create(const source, dest :AnsiString; const overwriteExists , startSuspended :Boolean);
79       destructor Destroy; override;
80   end;
81
82 ////////////////////////////////////////////////////////////////////////////////
83 //  áàçîâûé êëàññ, äëÿ ïðåäñòàâëåíèÿ ôàéëà èëè ïàïêè
84   TFileSystemElemInfo = class
85     protected
86       SearchRec :TSearchRec;
87     public
88       // àáñîëþòíûé ïóòü ê ôàéëó èëè ïàïêå
89       FullPath :AnsiString;
90       constructor Create(const filePath :AnsiString); overload; virtual;
91       constructor Create(const filePath: AnsiString; const searchInfo :TSearchRec); overload; virtual;
92       function  Name :AnsiString; virtual;
93       function  Attributes :Longint; virtual;
94       function  Exists :Boolean; virtual; abstract;
95       function  CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; virtual; abstract;
96       function  Delete :Boolean; virtual ;abstract;
97   end;
98
99 ////////////////////////////////////////////////////////////////////////////////
100 //  êëàññ äëÿ ðàáîòû ñ ôàéëàìè
101   TFileInfo = class (TFileSystemElemInfo)
102     public
103       function CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; override;
104       function Delete :Boolean; override;
105       function Exists :Boolean; override;
106   end;
107  
108 ////////////////////////////////////////////////////////////////////////////////
109 //  êëàññ äëÿ ðàáîòû ñ äèðåêòîðèåé
110   TDirectoryInfo = class (TFileSystemElemInfo)
111     public
112       function CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; override;
113       function Delete :Boolean; override;
114       function Exists :Boolean; override;
115       function GetFiles :TFileSystemIterator; overload;
116       function GetFiles(const mask :AnsiString) :TFileSystemIterator; overload;
117       function GetDirectories :TFileSystemIterator; overload;
118       function GetDirectories(const mask :AnsiString) :TFileSystemIterator; overload;
119   end;
120  
121 ////////////////////////////////////////////////////////////////////////////////
122 // êëàññ äëÿ ïåðåáîðà ôàéëîâ è ïîääèðåêîðèé â äèðåêòîðèè
123   TFileSystemIterator = class
124     protected
125       searchInfo :TSearchRec;
126       folder     :AnsiString;
127     public
128       Current    :TFileSystemElemInfo;  // òåêóùèé ôàéë\ïàïêà
129       SearchAttr :Longint;
130       constructor Create(const folderPath :AnsiString; const onlyFiles :Boolean = false); overload;
131       constructor Create(const folderPath :AnsiString; const attrPredicat :Longint); overload;
132       constructor Create(const folderPath, searchMask :AnsiString; const onlyFiles :Boolean = false); overload;
133       constructor Create(const folderPath, searchMask :AnsiString; const attrPredicat :Longint); overload; //
134       destructor  Destroy; override;
135       function Next :Boolean;
136   end;
137
138 // Êëàññ äëÿ ðàáîòû ñ âðåìåííûìè ïàïêàìè. ×èñòèò temp ïî çàâåðøåíèþ ðàáîòû.
139   TTempFolder = class
140     protected
141       path :AnsiString;
142       name :AnsiString;
143     public
144       constructor Create(const subName :AnsiString);
145       destructor  Destroy; override;
146       function GetTempPath :AnsiString;   //ïîëó÷èòü ïóòü ê âðåìåííîé äèðåêòîðèè
147   end;
148  
149 ////////////////////////////////////////////////////////////////////////////////
150 //  Ïðîöåäóðû è ôóíêöèè
151 ////////////////////////////////////////////////////////////////////////////////
152
153 // êîïèðóåò äèððåêòîðèþ
154 function CopyDirectory(const sourceDir, destDir :AnsiString; const overwriteExists :Boolean = false;
155                         const recursive :Boolean = true) :Boolean;
156
157
158 //AsyncCopyFile - êîïèðóåò ôàéë â îòäåëüíîì ïîòîêå
159 function AsyncCopyFileEx(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
160                         const onProgress :TCopyFileProgressCallback; const overwriteExists :Boolean = false) :TThread;
161 function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
162                         const overwriteExists :Boolean = false) :TThread;
163
164 // SysFileExists - ïðîâåðÿåò ñóùåñòâóåò ëè ïî óêàçàííîìó ïóòè ôàéë èëè ïàïêà
165 function FileSystemElemExists(const path :AnsiString) :Boolean;
166
167 // IsDirectory - ïðîâåðÿåò ïî ïóòè èëè àòðèáóòàì ÿâëÿåòñÿ èëè "ýòî" ïàïêîé
168 function IsDirectory(const path :AnsiString) :Boolean; overload;
169 function IsDirectory(const attr :Longint) :Boolean; overload;
170
171 Function IsLocalPath(const PathStr : AnsiString) : boolean;     //Âîçâðàùàåò true åñëè ïóòü ëîêàëüíûé, è false åñëè ãëîáàëüíûé. Ïîä ëîêàëüíûì ïîíèìàåòñÿ ïóòü íà÷èíàþùèéñÿ ñ òî÷êè.
172 Function IsGlobalPath(const PathStr : AnsiString) : boolean;   //Âîçâðàùàåò true åñëè ïóòü ãëîáàëüíûé. Ïîä ãëîáàëüíûì ïîíèìàåòñÿ ïóòü, íà÷èíàþùèéñÿ íà èìÿ äèñêà (ôóíêöèÿ äëÿ âåíäîâ).
173 Function FixLocalPath(const PathStr : AnsiString) : AnsiString;   //Ïðàâèëüíî îôîðìëÿåò ïðåäïîëîæèòåëüíî ëîêàëüíûé íî íåïðàâèëüíî îôîðìëåííûé ïóòü - ÷òîá áûëà òî÷êà â íà÷àëå.
174 Function ResolveLocalPath(const LocalPath, GlobalPath : AnsiString) : AnsiString;  //Ïðåâðàòèòü îòíîñèòåëüíûé ïóòü â àáñîëþòíûé
175 Function GetLocalPath(const GlobalRoot, FullPath : AnsiString): AnsiString;    //Âåðíóòü îòíîñèòåëüíûé ïóòü.
176 Function GetFileSize(const FileName : AnsiString) : Int64;   //Ïîëó÷èòü ðàçìåð ôàéëà.
177 function GetFilesNumber(const DirName : AnsiString; const Recursive : boolean) : LongInt;//Ïîäñ÷èòàòü êîëè÷åñòâî ôàéëîâ è ïàïîê â ïàïêå...
178 Function IsDirsChild(const DirName, ChildName : AnsiString) : boolean;   //Ïðîâåðèòü - ïðèíàäëåæèò ëè ïóòü ChildName ïóòè DirName.
179 function AddExtensionIfAbsent(const path, extension :String) :String; // äîáàëÿåò ðàñøèðåíèå åñëè åãî åùå íåò.
180 function GetFileNameWithoutExtension(const path :String) :String;  // ÷èñòîå èìÿ ôàéëà, áåç ðàñøèðåíèÿ
181 Function HasLastSlash(const Str : string) : boolean;    //Ôóíêà äëÿ ïðîâåðêè íàëè÷èÿ ïîñëåäíåãî ñëýøà.
182 Function AddLastSlash(const str : string) : string;     //Ôóíêà äëÿ äîáàâëåíèÿ â ïóòü ïîñëåäíåãî ñëýøà (åñëè íàäî).
183 Function DelLastSlash(const Str : string) : string;     //Óäàëÿåò ïîñëåäíèé ñëåø åñëè îí åñòü.
184
185 implementation
186
187 //////////////////////////  TFileSystemIterator     ///////////////////////////////
188 constructor TFileSystemIterator.Create(const folderPath :AnsiString; const onlyFiles :Boolean = false);
189 begin
190   Create(folderPath, AllDirectoryEntriesMask, onlyFiles);
191 end;
192
193 constructor TFileSystemIterator.Create(const folderPath :AnsiString; const attrPredicat :Longint);
194 begin
195   Create(folderPath, AllDirectoryEntriesMask, attrPredicat);
196 end;
197
198 constructor TFileSystemIterator.Create(const folderPath, searchMask :AnsiString; const onlyFiles :Boolean = false);
199 var
200   temp :Longint;
201 begin
202   temp := faAnyFile;
203   if onlyFiles then begin
204     temp := temp and not faDirectory;
205   end;
206   Create(folderPath, searchMask, temp);
207 end;
208
209 constructor TFileSystemIterator.Create(const folderPath, searchMask :AnsiString; const attrPredicat :Longint);
210 begin
211   inherited Create;
212   Self.SearchAttr := attrPredicat;
213   Self.folder := folderPath;
214   FindFirst(AppendPathDelim(folderPath) + searchMask, faAnyFile, searchInfo);
215 end;
216
217 destructor TFileSystemIterator.Destroy;
218 begin
219   inherited;
220   FindClose(searchInfo);
221 end;
222
223 function TFileSystemIterator.Next :Boolean;
224 begin
225   Result := (FindNext(searchInfo) = 0);
226   if not Result then exit;
227  
228   if (searchInfo.Name = '.') or (searchInfo.Name = '..') then begin
229     Result := Self.Next;
230     exit;
231   end;
232  
233   if (searchInfo.Attr and SearchAttr) = 0 then begin
234     Result := Self.Next;
235     exit;
236   end;
237
238   if IsDirectory(searchInfo.Attr) then
239     Current := TDirectoryInfo.Create(folder, searchInfo)
240   else
241     Current := TFileInfo.Create(folder, searchInfo);
242
243 end;
244
245 ///////////////////              TCopyFileThread             ///////////////////
246
247 //  êîíñòðóêòîð
248 constructor TCopyFileThread.Create(const source, dest :AnsiString; const overwriteExists, startSuspended :Boolean);
249 begin
250   inherited Create(startSuspended);
251   SourceFilePath := source;
252   DestFilePath   := dest;
253   self.OverwriteExists := overwriteExists;
254   self._current := 0;
255   Self._total := -1;
256   totalLock := TCriticalSection.Create;
257   curLock   := TCriticalSection.Create;
258 end;
259
260 destructor TCopyFileThread.Destroy;
261 begin
262   inherited;
263   totalLock.Free;
264   curLock.Free;
265 end;
266
267 //  ïðîöåäóðà , êîïèðóåò ôàéë.
268 procedure TCopyFileThread.Execute;
269 var
270   sourceStream :TFileStream;
271   destStream   :TFileStream;
272   curr, max    :Int64;
273   stepReaded   :Integer;
274   part, temp   :Int64;
275   buffer       :array[0 .. FILECOPY_BUFFER_SIZE - 1] of byte;
276 begin
277   CopyResult := false;
278  
279   if not FileExists(SourceFilePath) then begin
280     if assigned (CopyFileFinish) then CopyFileFinish(false);
281     exit;
282   end;
283  
284   // Ïðîâåðÿåì ñóùåñòóåò ëè ôàéë êîòîðûé ìû ñîáèðàåìñÿ ñîçäàòü. Åñëè äà - òî åñëè ðàçðåøåííî ïðîáóåì óäàëèòü,
285   // â ñëó÷àå íåóäà÷è âûõîäèì.
286   if FileExists(DestFilePath) then begin
287     if (not OverwriteExists) or (not DeleteFile(DestFilePath)) then begin
288       if assigned (CopyFileFinish) then CopyFileFinish(false);
289       exit;
290     end;
291   end;
292  
293   // îòêðûâàåì ïîòîêè
294   sourceStream := TFileStream.Create(SourceFilePath, fmOpenRead);
295   destStream   := TFileStream.Create(DestFilePath, fmCreate);
296  
297   curr := 0;
298   max := sourceStream.Size;
299   SetTotal(max);
300   part := total div 100;
301   temp := 0;
302
303   try
304     while (curr < max) do begin
305       stepReaded := sourceStream.Read(buffer, FILECOPY_BUFFER_SIZE);
306       destStream.Write(buffer, stepReaded);
307       curr := curr + stepReaded;
308       SetCurrent(curr);
309       // áóäåì ñîîáùàòü î ïðîãðåññå ïî îêîí÷àíèþ êîïèðîâàíèÿ êàæäîé 100-é ÷àñòè,
310       // ÷òîáû íå ïåðåãðóæàòü ïîòîê âûçîâàìè.
311       if assigned(CopyFileProgress) then begin
312         temp := temp + stepReaded;
313         if temp >= part then begin
314           temp := temp mod part;
315           CopyFileProgress(curr, max);
316         end;
317       end;
318     end;
319   finally
320     sourceStream.Free;
321     destStream.Free;
322   end;
323  
324   CopyResult := true;
325   if assigned (CopyFileFinish) then CopyFileFinish(CopyResult);
326
327 end;
328
329
330 function TCopyFileThread.GetTotal :Int64;
331 begin
332   totalLock.Acquire;
333   try
334     Result := _total;
335   finally
336     totalLock.Release;
337   end;
338 end;
339
340 procedure TCopyFileThread.SetTotal(const value :Int64);
341 begin
342   totalLock.Acquire;
343   try
344     _total := value;
345   finally
346     totalLock.Release;
347   end;
348 end;
349
350 function TCopyFileThread.GetCurrent :Int64;
351 begin
352   curLock.Acquire;
353   try
354     Result := _current;
355   finally
356     curLock.Release;
357   end;
358 end;
359
360 procedure TCopyFileThread.SetCurrent(const value :Int64);
361 begin
362   curLock.Acquire;
363   try
364     _current := value;
365   finally
366     curLock.Release;
367   end;
368 end;
369
370 ///////////////////////  TFileSystemIterator  & co    /////////////////////////////
371
372 // êîíñòðóêòîð
373 constructor TFileSystemElemInfo.Create(const filePath :AnsiString);
374 begin
375   inherited Create;
376   Self.FullPath := filePath;
377 end;
378
379 // êîíñòðóêòîð
380 constructor TFileSystemElemInfo.Create(const filePath: AnsiString; const searchInfo :TSearchRec);
381 begin
382   Create(AppendPathDelim(filePath) + searchInfo.Name);
383   Self.SearchRec := searchInfo;
384 end;
385
386 // âçÿòü àòòðèáóò
387 function TFileSystemElemInfo.Attributes :Longint;
388 begin
389   // åñëè îïðåäåëåíà ñòðóêòóðà SearchRec
390   if (SearchRec.FindHandle = 0) then
391     Result := INVALID_SYSFILE_ATTR
392   else
393     Result := SearchRec.Attr;
394 end;
395
396 // èçâëå÷ü èìÿ èç ïóòè
397 function TFileSystemElemInfo.Name :AnsiString;
398 begin
399   Result := SearchRec.Name;
400   if (Result = '') then
401     Result := ExtractFileName(FullPath);
402 end;
403
404 // êîïàåò
405 function TFileInfo.CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean;
406 begin
407   if FileExists(path) then begin
408     if overwriteExists then begin
409       if not DeleteFile(path) then begin
410         Result := false;
411         exit;
412       end;
413     end else begin
414       Result := true;
415       exit;
416     end;
417   end;
418   {$IFDEF LCL}
419   Result := FileUtil.CopyFile(FullPath, path);
420   {$ELSE}
421   Result := Windows.CopyFile(PChar(FullPath), PChar(path), false);
422   {$ENDIF}
423 end;
424
425 // óäàëÿåò
426 function TFileInfo.Delete :Boolean;
427 begin
428   Result := false;
429   if FileExists(FullPath) then
430     Result := DeleteFile(FullPath);
431 end;
432
433 // à åñòü ëè ó íàñ òàêîé ôàéë?
434 function TFileInfo.Exists :Boolean;
435 begin
436   Result := FileExists(FullPath);
437 end;
438
439 // òîæå êîïèðóåò.
440 function TDirectoryInfo.CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean;
441 begin
442   Result := CopyDirectory(FullPath, path, overwriteExists, true);
443 end;
444
445 // óäàëÿåò íàôèã.
446 function TDirectoryInfo.Delete :Boolean;
447 begin
448   Result := DeleteDirectory(FullPath, false);
449 end;
450
451 // åñòü ëè ïàïêà
452 function TDirectoryInfo.Exists :Boolean;
453 begin
454   Result := DirectoryExists(FullPath);
455 end;
456
457 // ïîëó÷èòü èòåðàòîð íà ôàéëû âíóòðè ïàïêè
458 function TDirectoryInfo.GetFiles: TFileSystemIterator;
459 begin
460   Result := GetFiles('*');
461 end;
462
463 // ïîëó÷èòü èòåðåàòîð íà âñå ÷àéëä-ïàïêè
464 function TDirectoryInfo.GetFiles(const mask :AnsiString) :TFileSystemIterator;
465 begin
466   Result := TFileSystemIterator.Create(FullPath, mask, true);
467 end;
468
469 function TDirectoryInfo.GetDirectories :TFileSystemIterator;
470 begin
471   Result := GetDirectories('*');
472 end;
473
474 function TDirectoryInfo.GetDirectories(const mask :AnsiString) :TFileSystemIterator;
475 begin
476   Result := TFileSystemIterator.Create(FullPath, mask, faDirectory);
477 end;
478
479 //////////////////////////  TTempFolder     ///////////////////////////////
480 // êîíñòðóêòîð. ñîçäàåò âðåìåííóþ äèðåêòîðèþ
481 constructor TTempFolder.Create(const subName :AnsiString);
482 var
483   temp :TGUID;
484 begin
485   CreateGUID(temp);
486   // ñîáñòâåííî ïóòü ê ïàïêå
487   path := AppendPathDelim(GetTempDir) + GUIDToString(temp) + PathDelim;
488   ForceDirectories(path + subName);
489   name := subName;
490 end;
491
492 // ÷èñòèò çà ñîáîé
493 destructor  TTempFolder.Destroy;
494 begin
495   inherited;
496   DeleteDirectory(path, false);
497 end;
498
499 //ïîëó÷èòü ïóòü ê âðåìåííîé äèðåêòîðèè
500 function TTempFolder.GetTempPath :AnsiString;
501 begin
502   Result := AppendPathDelim(path + name);
503 end;
504
505 ////////////////////////////////////////////////////////////////////////////////
506 // êîïèðóåò äèðåêòîðèþ
507 function CopyDirectory(const sourceDir, destDir :AnsiString; const overwriteExists :Boolean = false;
508                         const recursive :Boolean = true) :Boolean;
509 var
510   it :TFileSystemIterator;
511 begin
512   Result := false;
513   if not DirectoryExists(sourceDir) then begin
514     exit;
515   end;
516   // åñëè destDir åùå íå ñóùåñòâóåò, ñîçäàåì
517   if not DirectoryExists(destDir) then ForceDirectories(destDir);
518   it := TFileSystemIterator.Create(sourceDir, not recursive);
519   try
520     while it.Next do begin
521       if not it.Current.CopyTo(AppendPathDelim(destDir) + it.Current.Name, overwriteExists) then begin
522         exit;
523       end;
524     end;
525     Result := true;
526   finally
527     it.Free;
528   end;
529 end;
530
531 // êîïèðóåò ôàéë â îòäåëüíîì ïîòîê
532 function AsyncCopyFileEx(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
533                        const onProgress :TCopyFileProgressCallback; const overwriteExists :Boolean = false) :TThread;
534 var
535   worker :TCopyFileThread;
536 begin
537   worker := TCopyFileThread.Create(sourcePath, destPath, overwriteExists ,true);
538   worker.CopyFileProgress := onProgress;
539   worker.CopyFileFinish   := onFinish;
540   worker.FreeOnTerminate  := true;
541   worker.Resume;
542   Result := worker;
543 end;
544
545 // êîïèðîâàíèÿ ôàéëà â îòäåëüíîì ïîòîêå
546 function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
547                         const overwriteExists :Boolean = false) :TThread;
548 begin
549   Result := AsyncCopyFileEx(sourcePath, destPath, onFinish, nil, overwriteExists);
550 end;
551
552 function FileSystemElemExists(const path :AnsiString) :Boolean;
553 begin
554   Result := (FileGetAttr(path) <> INVALID_SYSFILE_ATTR);
555 end;
556
557 // à äèðåêòîðèÿ ëè ïî ïåðåäàííîìó ïóòè ?
558 function IsDirectory(const path :AnsiString) :Boolean;
559 var
560   attr :Longint;
561 begin
562   attr := FileGetAttr(path);
563   if attr <> INVALID_SYSFILE_ATTR then begin
564     Result := IsDirectory(attr);
565   end else
566     Result  := false;
567 end;
568
569 // ïðîâåðÿò ÿâëÿåòñÿ ëè ñèñòåìíûé ôàéë äèðåêòîðèåé ïî àòòðèáóòàì
570 function IsDirectory(const attr :Longint) :Boolean;
571 begin
572   Result := (attr and faDirectory) = faDirectory;
573 end;
574
575
576 ////////////////   èìïîðò èç ExtraFunctionsCLC  ////////////////////////////////
577 Function IsLocalPath(const PathStr : string) : boolean;
578 //Âîçâðàùàåò true åñëè ïóòü ëîêàëüíûé, è false åñëè ãëîáàëüíûé.
579 //Ïîä ëîêàëüíûì ïîíèìàåòñÿ ïóòü íà÷èíàþùèéñÿ ñ òî÷êè.
580 begin
581   Result := false;   //Ïî óìîë÷àíèþ ñ÷èòàåì ÷òî ïóòü ãëîáàëåí.
582
583   if Length(PathStr) >= 1 then begin
584     if PathStr[1] = '.' then begin
585       Result := true;
586     end;
587   end;
588 end;
589
590 Function IsGlobalPath(const PathStr : AnsiString) : boolean;
591 //Âîçâðàùàåò true åñëè ïóòü ãëîáàëüíûé. Ïîä ãëîáàëüíûì ïîíèìàåòñÿ ïóòü,
592 //íà÷èíàþùèéñÿ íà èìÿ äèñêà (ôóíêöèÿ äëÿ âåíäîâ).
593 begin
594   Result := false;   //Ïî óìîë÷àíèþ ñ÷èòàåì ÷òî ïóòü íå ãëîáàëåí.
595
596   if Length(PathStr) >= 3 then begin
597     if PathStr[2]+PathStr[3] = ':\' then begin
598       Result := true;
599     end;
600   end;
601 end;
602
603 Function FixLocalPath(const PathStr : AnsiString) : AnsiString;
604 //Ïðàâèëüíî îôîðìëÿåò ïðåäïîëîæèòåëüíî ëîêàëüíûé íî íåïðàâèëüíî îôîðìëåííûé
605 //ïóòü - ÷òîá áûëà òî÷êà â íà÷àëå.
606 begin
607   Result := PathStr;
608
609   if IsLocalPath(Result) = false then begin
610     if Length(Result) >= 1 then begin
611       if Result[1] <> '\' then begin
612         Result := '\'+Result;
613       end;
614     end
615     else begin
616       Result := '\'+Result;
617     end;
618     Result := '.'+Result;
619   end;
620 end;
621
622 Function ResolveLocalPath(const LocalPath, GlobalPath : AnsiString) : AnsiString;
623 //Ïðåâðàòèòü îòíîñèòåëüíûé ïóòü â àáñîëþòíûé. Åñëè îòíîñèòåëüíûé ïóòü çàäàí íåïðàâèëüíî - ïðåäâàðèòåëüíî
624 //áóäåò ïîôèêñàí. Åñëè îòíîñèòåëüíûé ïóòü íà ñàìîì äåëå àáñîëþòíûé - âåðíåò àáñîëþòíûé ïóòü
625 //êîòîðûé ÿêîáû îòíîñèòåëüíûé.
626 var
627   TempLocalPath, LocalParsed : AnsiString;
628 begin
629   //Ïðèíöèï äåéñòâèÿ: â îòíîñèòåëüíîì ïóòè ìîãóò áûòü òî÷êè è "äâîåòî÷èÿ".
630   //Êîïèðóåì â ðåçóëüòàò àáñîëþòíûé ïóòü, óáèðàåì ïîñëåäíèé ñëåø,
631   //è äàëüøå ïàðñèì ëîêàëüíûé ïóòü (ïî ñëåøàì) - âñòðå÷àåì òî÷êó - íè÷Î íå äåëàåì,
632   //âñòðå÷àåì äâîåòî÷èå - îòðåçàåì îò ðåçóëüòàòà êóñîê äî ïîñëåäíåãî ñëåøà âêëþ÷èòåëüíî,
633   //âñòðå÷àåì ÷òî-òî åùå - äîáàâëÿåì â ðåçóëüòàò ñëåø è êîïèðóåì ïðîïàðñåííîå òóäà æå.
634   // èòîãå ïîëó÷àåì àáñîëþòíûé ïóòü.
635
636   //Êîïèðóåì â ðåçóëüòàò àáñîëþòíûé ïóòü, óáèðàåì ïîñëåäíèé ñëåø.
637   Result := ChompPathDelim(GlobalPath);
638   TempLocalPath := LocalPath;     //Ýòî ÷òîá íå ïîðòèòü ïðèñëàííûé â ôóíêöèþ àðãóìåíò.
639  
640   //Ïðîâåðÿåì - íàäî ëè ïîôèêñàòü ëîêàëüíûé ïóòü? À åñëè íàäî - òî êàê ðàç ïîôèêñàòü.
641   if IsGlobalPath(TempLocalPath) = false then begin
642     //Ïóòü íå ãëîáàëåí. Îôîðìëåí ëè îí êàê ëîêàëüíûé?
643     if IsLocalPath(TempLocalPath) = false then begin
644       //Êàê ëîêàëüíûé òîæå íå îôîðìëåí - îôîðìëÿåì.
645       TempLocalPath := FixLocalPath(TempLocalPath);
646     end;
647   end;
648  
649   //Òåïåðü - åñëè ëîêàëüíûé ïóòü äåéñòâèòåëüíî ëîêàëüíûé - òî ðàáîòàåì.
650   if IsLocalPath(TempLocalPath) = true then begin
651     repeat
652       //Ïàðñèì...
653       LocalParsed := Parse(TempLocalPath,'\');
654
655       //Ñìîòðÿ ÷åãî âûïàðñèëè...
656       if (LocalParsed = '.') or (LocalParsed = '') then begin
657         //Åñëè òî÷êà ëèáî ïðîñòî ñëåø áåç âñåãî - òî íè÷åãî íå äåëàòü.
658       end
659       else if LocalParsed = '..' then begin
660         //Äâå òî÷êè - ïîäíÿòñÿ íà óðîâåíü âûøå...
661         ParseTail(Result,'\');
662       end
663       else begin
664         //Åñëè òàì åùå êàêàÿ-òî ôèãíÿ - òî äîáàâëÿåì åž ê ïóòè...
665         Result := Result+'\'+LocalParsed;
666       end;
667
668     until TempLocalPath = '';
669
670     //Ãîòîâî. Òåïåðü åñëè â LocalPath â êîíöå áûë ñëåø - äîáàâèì è ê ðåçóëüòàòó...
671     if HasLastSlash(LocalPath) = true then begin
672       Result := Result+'\';
673     end;
674   end
675   else begin
676     //Ëîêàëüíûé ïóòü íà ñàìîì äåëå àáñîëþòíûé - åãî è âîçâðàùàåì.
677     Result := TempLocalPath;
678   end;
679
680 end;
681
682 Function GetLocalPath(const GlobalRoot, FullPath : AnsiString): AnsiString;
683 //Âåðíóòü îòíîñèòåëüíûé ïóòü.
684 var
685   TmpGlobalRoot, TmpFullPath, CommonPart, TempStr : AnsiString;
686   Finded : boolean;
687
688 begin
689   //Åñëè ãëîáàëüíûé êîðíåâîé ïóòü íå âõîäèò â ñîñòàâ ïîëíîãî ïóòè.
690   if StrPos(PChar(UpperCase(FullPath)),PChar(DelLastSlash(UpperCase(GlobalRoot)))) = nil then begin
691
692     //Ïðîâåðèòü - ñîâïàäàåò ëè ïåðâûé ýëåìåíò ïóòè äî ïåðâîãî ñëåøà - ïîä âåíäàìè ýòî áóäåò áóêâà äèñêà,
693     //ïîä êàêèì íèòü ëèíóõîì â òåîðèè îäèíàêîâàÿ ïóñòàÿ ñòðîêà.
694     TmpGlobalRoot := AddLastSlash(GlobalRoot);
695     TmpFullPath := AddLastSlash(FullPath);
696     if UpperCase(Parse(TmpGlobalRoot,'\')) = UpperCase(Parse(TmpFullPath,'\')) then begin
697       //Åñëè "äèñê" îäèí è òîò æå - òîãäà ôîðìèðóåì îòíîñèòåëüíûé ïóòü ñ "äâîåòî÷èÿìè".
698
699       //Èùåì îáùóþ ÷àñòü ïóòè...
700       CommonPart := '';
701       Finded := false;
702       TmpGlobalRoot := DelLastSlash(GlobalRoot);
703       TmpFullPath := DelLastSlash(FullPath);
704       repeat
705         TempStr := Parse(TmpGlobalRoot,'\');
706         if UpperCase(TempStr) = UpperCase(Parse(TmpFullPath,'\')) then begin
707           //Êóñîê ïóòè ñîâïàäàåò.
708           CommonPart := CommonPart+TempStr+'\';
709         end
710         else begin
711           //Íå ñîâïàëî. Äåëàåì îòìåòêó. Ïóòü îñòàåòñÿ ñ ïîñëåäíèì ñëåøåì.
712           Finded := true;
713         end;
714       until Finded = true;
715
716       //Òåðü ãåíåðèì îáðåçêè ïóòåé ÷òîá áûëè áåç îáùåé ÷àñòè...
717       TmpGlobalRoot := AddLastSlash(GlobalRoot);
718       TmpFullPath := AddLastSlash(FullPath);
719       TmpGlobalRoot := DelLastSlash(RightStr(TmpGlobalRoot,Length(TmpGlobalRoot)-Length(CommonPart)));
720       TmpFullPath := DelLastSlash(RightStr(TmpFullPath,Length(TmpFullPath)-Length(CommonPart)));
721       //Òåïåðü ìîæíî ñãåíåðèòü íà÷àëî ðåçóëüòàòà èç äâîåòî÷èé...
722       Result := '';
723       repeat
724         //Ïàðñèì ïîêà TmpGlobalRoot íå îïóñòååò.
725         if Parse(TmpGlobalRoot,'\') <> '' then begin
726           //Åñëè åùå ÷åãî-òî ïðîïàðñèëîñü - äîáàâëÿåì äâå òî÷êè...
727           Result := Result+'..\';
728         end;
729       until TmpGlobalRoot = '';
730       //Òåïåðü äîáàâëÿåì îáðåçîê ïîëíîãî ïóòè.
731       Result := Result+TmpFullPath;
732       //Âñå, ìîæíî âûõîäèòü.
733       Exit;
734     end
735     else begin
736       //Åñëè "äèñê"-è ðàçíûå - ïðîñòî âîçâðàùàåì ïîëíûé ïóòü
737       Result := FullPath;
738       Exit;
739     end;
740
741   end;
742
743   //Åñëè ó íàñ îäèí è òîò æå ïóòü è òàì è òàì - òî ñðàçó âîçâðàùàåì ./
744   if UpperCase(DelLastSlash(GlobalRoot)) = UpperCase(DelLastSlash(FullPath)) then begin
745     Result := '.\';
746     Exit;
747   end;
748
749   //Âçÿòü êîïèþ âõîäíîé èíôû...
750   TmpGlobalRoot := AddLastSlash(GlobalRoot);
751   TmpFullPath := FullPath;
752
753   TmpFullPath := RightStr(TmpFullPath,Length(TmpFullPath)-Length(TmpGlobalRoot));
754   Result := '.\'+TmpFullPath;
755 end;
756
757 Function GetFileSize(const FileName : AnsiString) : Int64;
758 //Ïîëó÷èòü ðàçìåð ôàéëà.
759 var
760   TheFileStream : TFileStream;
761 begin
762   //Ïî óìîë÷àíèþ âîçâðàùàåì íîëü.
763   Result := 0;
764   //Åñëè ôàéë ñóùåñòâóåò...
765   if FileExists(FileName) = true then begin
766     //... òî îòêðûâàåì åãî...
767     TheFileStream := TFileStream.Create(FileName,fmOpenRead);
768     //... è ïîëó÷àåì ðàçìåð.
769     Result := TheFileStream.Size;
770     //È çàêðûâàåì ôàéëåã.
771     TheFileStream.Free;
772   end;
773 end;
774
775 Function GetFilesNumber(const DirName : AnsiString; const Recursive : boolean) : LongInt;
776 //Ïîäñ÷èòàòü êîëè÷åñòâî ôàéëîâ è ïàïîê â ïàïêå...
777 var
778   SearchRec : TSearchRec;
779 begin
780   Result := 0;
781
782   if FindFirst(AddLastSlash(DirName)+'*', faAnyFile and faDirectory, SearchRec) = 0 then begin
783     //Åñëè ïîèñê íà÷àò óñïåøíî - íà÷èíàåì (ðåêóðñèâíî åñëè íàäî) ñ÷èòàòü ñîäåðæèìîå.
784     repeat
785       if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
786         //×åãî-òî íàøëè.
787         Result := Result+1;
788         //Writeln(SearchRec.Name);
789         if Recursive = true then begin
790           //Åñëè íàäî äåéñòâîâàòü ðåêóðñèâíî...
791           if (SearchRec.Attr and faDirectory) = faDirectory then begin
792             //... è åñëè ýòî äèðåêòîðèÿ - òî ïîäñ÷èòûâàåì ýòó äèðåêòîðèþ.
793             Result := Result+GetFilesNumber(AddLastSlash(DirName)+SearchRec.Name, Recursive);
794           end;
795         end;
796       end;;
797     until FindNext(SearchRec) <> 0;
798     SysUtils.FindClose(SearchRec);
799   end;
800   //Writeln(IntToStr(Result));
801
802 end;
803
804 Function IsDirsChild(const DirName, ChildName : AnsiString) : boolean;
805 //Ïðîâåðèòü - ïðèíàäëåæèò ëè ïóòü ChildName ïóòè DirName.
806 var
807   TempStr : AnsiString;
808 begin
809   //Èíèöèàëèçàöèÿ.
810   Result := false;     //Èçíà÷àëüíî ïóòü íå ñ÷èòàåòñÿ child-îì
811
812   //Ïîëó÷åíèå "ëîêàëüíîãî ïóòè".
813   TempStr := GetLocalPath(DirName,ChildName);
814   //Ïðîâåðêà - åñòü ëè òàì ".\"
815   if Length(TempStr) > 1 then begin
816     //Òîëüêî åñëè èñêîìîå ìîãëî ïîìåñòèòüñÿ â ñòðîêó.
817     if TempStr[1]+TempStr[2] = '.\' then begin
818       //Èçó÷àåìûé ïóòü ÿâëÿåòñÿ child-îì DirName
819       Result := true;
820     end;
821   end;
822 end;
823
824 // äîáàëÿåò ðàñøèðåíèå åñëè åãî åùå íåò.
825 function AddExtensionIfAbsent(const path, extension :String) :String;
826 var
827   ex :AnsiString;
828 begin
829   Result := path;
830   ex := ExtractFileExt(path);
831   if (ex = '') then begin
832     Result := path + extension;
833   end;
834 end;
835
836 // ÷èñòîå èìÿ ôàéëà, áåç ðàñøèðåíèÿ
837 function GetFileNameWithoutExtension(const path :String) :String;
838 var
839   fileName :String;
840   i        :Integer;
841 begin
842   fileName := ExtractFileName(path);
843   i := Length(FileName);
844   while (i > 0) and (FileName[i] <> '.') do Dec(i);
845
846   if (i > 0) then
847     Result := Copy(FileName, 1, i - 1)
848   else
849     Result := fileName;
850 end;
851
852 Function HasLastSlash(const Str : string) : boolean;
853 //Ôóíêà äëÿ ïðîâåðêè íàëè÷èÿ ïîñëåäíåãî ñëýøà.
854 var
855   I : integer;
856   LastCh : char;
857 begin
858   if Length(Str) > 0 then begin
859     //Ñìûñë ÷òî-òî ïðîâåðÿòü åñòü òîëüêî åñëè ñòðîêà íå ïóñòà.
860     I := 0;
861     LastCh := #0;
862     repeat
863       I := I+1;
864       If str[I] <> #0 then begin
865         LastCh := str[I];
866       end;
867     until str[I] = #0;
868     //Åñëè ïîñëåäíèé ñèìâîë ñëýø òî ðåçóëò òðó, èíà÷å ôàëñ:
869     If LastCh = '\' then result := true
870     else result := false;
871   end
872   else begin
873     //À åñëè ñòðîêà ïóñòà - òî îíî âñåãäà ôàëñå.
874     Result := false;
875   end;
876 end;
877
878 Function AddLastSlash(const str : string): string;
879 //Ôóíêà äëÿ äîáàâëåíèÿ â ïóòü ïîñëåäíåãî ñëýøà (åñëè íàäî).
880 begin
881   //Åñëè ïîñëåäíèé ñèìâîë íå ñëýø - òî ïðèïëþñîâàòèòü åãî òóäû.
882   If HasLastSlash(str) = false then result := str+'\'
883   else result := str;
884 end;
885
886 Function DelLastSlash(const Str : string) : string;
887 //Óäàëÿåò ïîñëåäíèé ñëåø åñëè îí åñòü.
888 begin
889   Result := '';
890   if HasLastSlash(Str) = true then begin
891     SetLength(Result,Length(Str)-1);
892     CopyMemory(@Result[1],@Str[1],Length(Str)-1);
893   end
894   else begin
895     Result := Str;
896   end;
897 end;
898
899 end.
900
Note: See TracBrowser for help on using the browser.