IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Проблемы с удалением директории, не получается удалить :)
LP
сообщение 9.12.2004 21:18
Сообщение #1


Гость






Привет всем! Помогите кому не трудно!
В общем в этой программе:
Код

program delete;
uses dos;
var f:string;
   attr:word;
procedure delete_file(filename:string);
var reg:registers;
begin
filename:=filename+chr(0);
reg.ah:=$41;
reg.dx:=ofs(filename[1]);
reg.ds:=seg(filename[1]);
msdos(reg);
if (reg.flags and 1)=1 then
begin
writeln('Ошибка. Код=',reg.ax);
halt;
end;
end;
procedure set_attr(filename:string;attr:word);
var reg:registers;
begin
filename:=filename+chr(0);
reg.ah:=$43;
reg.dx:=ofs(filename[1]);
reg.ds:=seg(filename[1]);
reg.al:=1;
reg.cx:=attr;
msdos(reg);
if (reg.flags and 1)=1 then
begin
writeln('Ошибка. Код=',reg.ax);
halt;
end;
end;
function get_attr(filename:string):word;
var reg:registers;
begin
filename:=filename+chr(0);
reg.ah:=$43;
reg.dx:=ofs(filename[1]);
reg.ds:=seg(filename[1]);
reg.al:=0;
msdos(reg);
if (reg.flags and 1)=1 then
begin
writeln('Ошибка. Код=',reg.ax);
halt;
end;
get_attr:=reg.cx;
end;
Begin
f:='d:\directory';
attr:=get_attr(f);
if attr=ReadOnly then set_attr(f,attr and 0);
delete_file(f);
end.


Не получается удалить папку, но c файлами все OK.
Запускал под в XP и под чистым ДОСом -разницы нет, папки не хотят удаляться. sad.gif
Правда в ДОСе выдается код ошибки 2(файл не найден), а в XP 5(доступ отвергнут).

Не забываем теги [ CODE] [ /CODE] для исходников

Сообщение отредактировано: volvo - 9.12.2004 21:21
 К началу страницы 
+ Ответить 
volvo
сообщение 9.12.2004 21:38
Сообщение #2


Гость






LP
А что, использовать функцию RmDir для удаления папки нельзя?
Код

Begin
 f:='d:\directory';
 attr:=get_attr(f);
 if attr=ReadOnly then set_attr(f,attr and 0);
 if attr=directory then rmdir(f)
 else delete_file(f);
end.
 К началу страницы 
+ Ответить 
Altair
сообщение 9.12.2004 21:45
Сообщение #3


Ищущий истину
******

Группа: Модераторы
Сообщений: 4 824
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Не пытайтесь только удалить папку в которой есть файлы, ничего не выйдет, сначала надо файлы удалить. ;)


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
LP
сообщение 9.12.2004 22:11
Сообщение #4


Гость






volvo,Oleg_Z cпасибо за ответы!

volvo, предмет наз-ся системное программирование, поэтому нельзя sad.gif


Oleg_Z , я с пустой папкой и пытался unsure.gif
Ладно, завтра на свежую голову еще раз посмотрю.
 К началу страницы 
+ Ответить 
Altair
сообщение 9.12.2004 22:15
Сообщение #5


Ищущий истину
******

Группа: Модераторы
Сообщений: 4 824
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Так, стоп, системное программирование говоришь?
так надо тогда использовать прерывание
INT21h
функцию 3Ah
эта функция удаляет поддиректорию, так-же как и RMDIR команда...

вот пример кода на чистом асме (под TASM)
Код

ASCstrg db 'C:\TESTDIR\',00H
Mov AH, 3AH
LEA DX,Ascstrg
INT 21H


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 9.12.2004 23:38
Сообщение #6


Гость






LP
А ведь Oleg_Z абсолютно прав - измени функцию Delete_File, чтобы она отдельно учитывала удаление папок:

Код

procedure delete_file(filename:string);
 var reg:registers;
 begin
   filename:=filename+chr(0);
   reg.ah:=$41 - 7*Byte(attr=directory);
   reg.dx:=ofs(filename[1]);
   reg.ds:=seg(filename[1]);
   msdos(reg);
   if (reg.flags and 1)=1 then
   begin
     writeln('Ошибка. Код=',reg.ax); halt;
   end;
 end;


Сообщение отредактировано: volvo - 9.12.2004 23:38
 К началу страницы 
+ Ответить 
LP
сообщение 10.12.2004 10:12
Сообщение #7


Гость






Спасибо! Помогло.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 18.07.2025 19:42
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"