Отправляет email-рассылки с помощью сервиса Sendsay

KLSoft company - программирование в Delphi и PHP

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Веб-разработка: пособие начинающим" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Апрель 2005   →
 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
Автор
ADMIN

Статистика

989 подписчиков
0 за неделю
←   Все выпуски   →

X-Program ПО, новости сайта и программирование в Delphi7


Информационный Канал Subscribe.Ru
Выпуск №48
*KLSoft* *форум delphi* *Исходники и компоненты* *free soft*
*Папки и Delphi* *Поиск файлов* *Строки* *Проверка имён*

Ну поехали...
>> Удаление непустого каталога вместе с подкаталогами
Удаление подкаталогов рекурсивное - функция вызывает саму себя.
Флаг RemoveRoot указывает на необходимость удаления корня.
Содержимое корня очищается в любом случае.

function FullRemoveDir(Dir:string; RemoveRoot:boolean):Boolean;
var i:Integer;
SRec:TSearchRec;
FN:String;
begin
Result:= False;
if Dir = '' then exit;
if not DirectoryExists(Dir) then exit;
Result:= True;
// Добавляем слэш в конце и задаем маску - "все файлы"
Dir:= IncludeTrailingBackslash(Dir) + '*.*';
i:= FindFirst(Dir, faAnyFile, SRec);
while i = 0 do
begin
// Получаем полный путь к файлу или директорию
FN:= ExtractFileDir(Dir)+'\'+SRec.Name;
// Если это директорий
if SRec.Attr = faDirectory then
begin
if (SRec.Name <> '' ) and (SRec.Name <> '.') and (SRec.Name <> '..') then
// Рекурсивный вызов этой же функции с ключом удаления корня
FullRemoveDir(FN,True);
end
else
// Иначе удаляем файл
begin
if SRec.Attr <> faArchive then FileSetAttr(FN, faArchive);
// Если хотя бы один файл не удален - результат отрицательный, но операция продолжается до конца
if not DeleteFile(FN) then Result:= false;
end;
// Берем следующий файл или директорий
i:= FindNext(SRec);
end;
FindClose(SRec);

// Если необходимо удалить корень - удаляем
if RemoveRoot then
try
if not RemoveDir(Dir) then Result:= false;
except
Result:= false;
end;

end;

>> Поиск файлов по маске по всему дереву каталогов, начиная с указанного
Продедура производит фалов по маске в указанном и во всех его вложенных
каталогах.
Параметр StartFolder указывает на начальный каталог поиска,
параметр Mask указывает маску поиска (например '*.pas'),
параметр List указывает на список строк, в которых будут записаны
результаты поиска,

Необязательный параметр ScanSubFolders указывает на необходимость
поиска во вложенных подкаталогах.

procedure FindFiles(StartFolder, Mask: String; List: TStrings;
ScanSubFolders: Boolean = True);
var
SearchRec: TSearchRec;
FindResult: Integer;
begin
List.BeginUpdate;
try
StartFolder:=IncludeTrailingBackslash(StartFolder);
FindResult:=FindFirst(StartFolder+'*.*', faAnyFile, SearchRec);
try
while FindResult = 0 do with SearchRec do begin
if (Attr and faDirectory)<>0 then begin
if ScanSubFolders and (Name<>'.') and (Name<>'..') then
FindFiles(StartFolder+Name, Mask, List, ScanSubFolders);
end else begin
if MatchesMask(Name, Mask) then List.Add(StartFolder+Name);
end;
FindResult:=FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
finally
List.EndUpdate;
end;
end;

Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
FindFiles('C:\Program Files\', '*.exe', memo1.Lines, true);
end;

>> Получение N-го слова из строки
{
Str: Строка
Smb: Разгранечительный символ
WordNmbr: Номер нужного сова
}
function GetWord(Str,Smb:String; WordNmbr: Byte):String;
var
SWord: String;
StrLen,N: Byte;
begin

StrLen:=SizeOf(Str);
N:=1;

while ((WordNmbr >= N) and (StrLen <> 0)) do
begin
StrLen := Pos(Smb,str);
if StrLen <> 0 then
begin
SWord:=Copy(Str,1,StrLen-1);
Delete(Str,1,StrLen);
Inc(N);
end
else SWord:=Str;
end;

if WordNmbr <= N then Result:=SWord else Result:='';
end;

Пример использования:
GetWord('Здесь ваш текст',' ',3); //Возвращает -> 'текст'

>> Проверка имени файла на наличие запрещённых символов (? * ...)
Не используйте функцию для проверки пути к какому-либо файлу и т.п.

function RightFileName(const FileName:string): boolean;
const
CHARS : array[1..10] of char =
('\', '/', ':', '*', '.', '?', '"', '<', '>', '|');
var
I : integer;
begin
for I:=1 to 10 do
if pos(CHARS[I],FileName)<>0 then //Найден запрещённый символ
begin
Result:=false;
Exit;
end;
Result:=true;
end;

Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
F:TextFile;
begin
if RightFileName(Edit1.Text) then
begin
AssignFile(F,Edit1.Text);
Rewrite(F);
CloseFile(F);
end
else
ShowMessage(
'Нельзя использовать символы \ / : * . ? " < > | в имени файла');
end;
Обратная связь
sms
Email
icq 		+79086491535
x-program@mail.ru
322284039
http://subscribe.ru/
http://subscribe.ru/feedback/		 Подписан адрес:
Код этой рассылки: comp.soft.prog.program		 Отписаться
В избранное