Советы по Delphi

Управление каталогами и файлами


    unit win95;
{
Копирование, перемещение и удаление файлов и каталогов наподобие Проводника (Explorer) в Windows 95. Дата  : 06/04/97 Последнее обновление: 03/08/97
Просьба сообщать о всех найденных ошибках и недочетах на мой

адрес электронной почты. Приветствуются пожелания и предложения по улучшению функциональности!!!
ОБНОВЛЕНИЯ: (18/04/97) Множество небольших поправок после множества ваших писем. Спасибо всем.
(31/08/97) Две новых процедуры: Win95AddToRecent и Win95ClearRecentDocs. }
interface
Uses Classes, ShellApi, ShlObj, Registry, Windows;
type
Str10  = String[10];
Const
fpRootKey ='\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders'; fpDesktop   : Str10 = 'DESKTOP'; fpFavorites : Str10 = 'FAVORITES'; fpFonts     : Str10 = 'FONTS'; fpPersonal  : Str10 = 'PERSONAL'; fpPrograms  : Str10 = 'PROGRAMS'; fpRecent    : Str10 = 'RECENT'; fpSendTo    : Str10 = 'SENDTO'; fpStartMenu : Str10 = 'START MENU'; fpStartup   : Str10 = 'STARTUP'; fpTemplates : Str10 = 'TEMPLATES';

{Пути к системным папкам}
function GetFolderPath(Const FolderName: Str10): String;

{Функции для работы с файлами}
procedure Win95AddToRecentDocs(Const Filename: string);
procedure Win95ClearRecentDocs;
{Для манипулирования несколькими файлами разделите их имена символом "#0"}
function Win95Copy(Owner: Integer;  FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean;
function Win95Move(Owner: Integer;  FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean;
{Если SendToRecycleBin = True, то файлы будут отправлены в Корзину (RecycleBin),
в противном случае они будут стерты} function Win95Erase(Owner: Integer;  WichFiles: String; SendToRecycleBin, Confirm: Boolean): Boolean;

implementation

function GetFolderPath(Const FolderName: Str10): String;
begin
with TRegistry.Create do Try RootKey:=HKEY_CURRENT_USER; OpenKey(fpRootKey,False); Result:=ReadString(FolderName); finally Free; end; end;

procedure Win95AddToRecentDocs(Const Filename: string);
begin
SHAddToRecentDocs(SHARD_PATH, @Filename[1]); end;

procedure Win95ClearRecentDocs;
begin
SHAddToRecentDocs(SHARD_PATH, nil); end;

function Win95Copy(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean;
const
Aborted: Boolean = False; var
Struct : TSHFileOpStructA; begin
While pos(';',FromFile)>0 do FromFile[pos(';',FromFile)]:=#0; While pos(';',ToFile)>0 do ToFile[pos(';',ToFile)]:=#0; FromFile:=FromFile+#0#0; ToFile:=ToFile+#0#0; with Struct do begin wnd         :=Owner; wFunc       :=FO_Copy; pFrom       :=PChar(FromFile); pTo         :=PChar(ToFile); fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY; If RenameOnCollision then fFLags:=fFlags or FOF_RENAMEONCOLLISION; If not Confirm then fFLags:=fFlags or FOF_NOCONFIRMATION; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end;

function Win95Move(Owner: Integer;  FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean;
const
Aborted: Boolean = False; var
Struct : TSHFileOpStructA; begin

While pos(';',FromFile)>0 do FromFile[pos(';',FromFile)]:=#0; While pos(';',ToFile)>0 do ToFile[pos(';',ToFile)]:=#0;
FromFile:=FromFile+#0#0; ToFile:=ToFile+#0#0; with Struct do begin wnd         :=Owner; wFunc       :=FO_Move; pFrom       :=PChar(FromFile); pTo         :=PChar(ToFile); fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY; If RenameOnCollision then fFLags:=fFlags or FOF_RENAMEONCOLLISION; If Confirm then fFLags:=fFlags or FOF_NOCONFIRMATION; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end;

function Win95Erase(Owner: Integer;  WichFiles: String;  SendToRecycleBin, Confirm: Boolean): Boolean;
const
Aborted: Boolean = False; var
Struct : TSHFileOpStructA; begin
While pos(';',WichFiles)>0 do WichFiles[pos(';',WichFiles)]:=#0; WichFiles:=WichFiles+#0#0; with Struct do begin wnd         :=Owner; wFunc       :=FO_Delete; pFrom       :=PChar(WichFiles); pTo         :=nil; If not Confirm then fFlags:=FOF_NOCONFIRMATION; If SendToRecycleBin then fFLags:=fFlags or FOF_ALLOWUNDO or FOF_FILESONLY else fFlags:=fFlags or 0 or FOF_FILESONLY; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end;

end.

[000268]



Содержание раздела