Пример кода по записи строки в текстовый файл. Получения кода ошибки, если такая возникнет в результате работы с файлом. Создание одно секундной задержки при каждом тике таймера прерываний.
{$M $1000,0,0}
program test2;
uses crt, dos;
var
OldText: Procedure;
filetext: text;
fname: string;
str: string;
t: word;
function GetIOErrorCode:integer;
begin
GetIOErrorCode := IOResult;
end;
function ConvIOErrorCodeToStrMsg(ioerrorcode:integer):string;
begin
case ioerrorcode of
0: ConvIOErrorCodeToStrMsg := 'Error not found';
3: ConvIOErrorCodeToStrMsg := 'Path not found';
4: ConvIOErrorCodeToStrMsg := 'Too many open files';
5: ConvIOErrorCodeToStrMsg := 'File access denied';
12: ConvIOErrorCodeToStrMsg := 'Invalid file access code';
16: ConvIOErrorCodeToStrMsg := 'Cannot remove current directory';
100: ConvIOErrorCodeToStrMsg := 'Disk read error';
101: ConvIOErrorCodeToStrMsg := 'Disk write error';
102: ConvIOErrorCodeToStrMsg := 'File not assigned';
103: ConvIOErrorCodeToStrMsg := 'File not open';
104: ConvIOErrorCodeToStrMsg := 'File not open for input';
105: ConvIOErrorCodeToStrMsg := 'File not open for output';
106: ConvIOErrorCodeToStrMsg := 'Invalid numeric format';
152: ConvIOErrorCodeToStrMsg := 'Drive not ready';
end;
end;
procedure savestringtofile(var f:text; var name, s:string);
begin
writeln;
{$I-}
assign(f, name);
append(f);
writeln(f, s);
close(f);
write('Message savestringtofile procedure: ' + ConvIOErrorCodeToStrMsg(GetIOErrorCode));
{$I+}
end;
procedure createfile(var f:text; var name:string);
begin
writeln;
{$I-}
assign(f, name);
rewrite(f);
close(f);
write('Message createfile procedure: ' + ConvIOErrorCodeToStrMsg(GetIOErrorCode));
{$I+}
end;
{$F+}
Procedure Text; Interrupt;
Begin
inc(t, 11);
if t>=100 then
begin
dec(t, 100);
savestringtofile(filetext, fname, str);
end;
Inline($9C);
OldText;
End;
{$F-}
Begin
fname := 'text.txt';
str := '1234567890';
t := 0;
createfile(filetext, fname);
GetIntVec($8,@OldText);
SetIntVec($8,Addr(Text));
Keep(0);
End.
