В общем в этой программе:
Код
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 и под чистым ДОСом -разницы нет, папки не хотят удаляться.
Правда в ДОСе выдается код ошибки 2(файл не найден), а в XP 5(доступ отвергнут).
Не забываем теги [ CODE] [ /CODE] для исходников
