типизированный файл - помогите

insidefuture · #1 05.05.2009, 18:16

Привет,

Как я могу сделать чтоб я могбы в типизированный файл постоянно добовлять новую информацыю при этом не уничтожая старую ?

я делаю так:

Цитата:

type

skaicius = record
pirmas : integer;
end;
.....

procedure TForm1.Button1Click(Sender: TObject);
var F : file of integer;
n : skaicius;
begin

assignfile(F, 'taspats.tts');
rewrite(F);

Edit1.Text:=IntToStr(StrToInt(Edit1.Text)+1);
n.pirmas:=StrToInt(Edit1.Text);
write(F, n.pirmas);
closefile(F);

end;

lmikle · #2 05.05.2009, 18:22

см процедуру seek.

Из хелпа:

Цитата:

To expand a file, seek one component beyond the last component; that is, the statement Seek(F, FileSize(F)) moves the current file position to the end of the file.

Страдалецъ · #3 05.05.2009, 19:18

1. Вообще если быть точным то файл у вас не типа интеджер, а типа skaicius.
2. Для записи в уже существующий файл надо применять Reset а не Rewrite;
3. Для добавления данных в конец файла, после его открытия надо установить указатель в конец файла, как советует lmikle.

insidefuture · #4 05.05.2009, 19:27

Спасибо уже оазобрался

roamer · #5 07.05.2009, 17:16

Когда-то пришлось писать базу данных в Pascal for DOS.
Тогда пришлось написать инструментарий.
Не шедевр (по текстам), но рабочий вариант.
Может кому-то пригодится.
================================

Код:

{Дополнить запись в конец файла}
function AppendRecToFile(NameF : String;
                         Var PBuf : Pointer;
                         SizeRec : LongInt) : LongInt;
{Записать запись в файл}
function PutRecToFile(NameF : String;
                      Var PBuf : Pointer;
                      NumRec,SizeRec : LongInt) : Boolean;
{Прочитать запись из файла по номеру}
function GetRecFromFile(NameF : String;
                        Var PBuf : Pointer;
                        NumRec,SizeRec : LongInt) : Boolean;
 
 
 
implementation
 
 
function GetFAttrWithNameFile(NameF : String;Var A : integer) : Boolean;
{Прочитать атрибуты файла}
{
faReadOnly  $00000001  Read-only files
faHidden    $00000002  Hidden files
faSysFile   $00000004  System files
faVolumeID  $00000008  Volume ID files
faDirectory $00000010  Directory files
faArchive   $00000020  Archive files
faAnyFile   $0000003F  Any file
}
begin
  Result:=false;
  A:=0;
  if FileExists(NameF) then begin
     A:=FileGetAttr(NameF);
     if A=128 then A:=0;
     if A>0 then begin
        Result:=true;
     end;
  end;
end;
 
 
function SetFAttrWithNameFile(NameF : String;A : integer) : Boolean;
{Записать атрибуты файла}
begin
  Result:=false;
  if FileExists(NameF) then begin
     Result:=true;
     if FileSetAttr(NameF,A)<0 then Result:=false;
  end;
end;
 
 
function CountRecInFile(NameF : String; SizeRec : LongInt) : LongInt;
{Количество записей в файле}
Var
  A : integer;
  Yes : Byte;
  CCC999 : LongInt;
  Ok99 : Boolean;
  FF : file of byte;
begin
  {SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);}
  Result:=-1;
  if SizeRec>0 then begin
     Yes:=0;
     CCC999:=0;
     if  GetFAttrWithNameFile(NameF,A) then begin
        if  SetFAttrWithNameFile(NameF,0) then begin
           AssignFile(FF,NameF);
           {$I-} reset(FF) {$I+};
           Ok99:=(IoResult=0);
           if Ok99 then begin
              {$I-} CCC999:=FileSize(FF) {$I+};
              Ok99:=(IoResult=0);
              if Ok99 then begin
                 Yes:=1;
              end;
              {$I-} CloseFile(FF) {$I+};
              Ok99:=(IoResult=0);
           end;
           if Yes>0 then begin
               Result:=trunc(CCC999/SizeRec);
           end;
        end;
        SetFAttrWithNameFile(NameF,A);
     end;
  end;
end;
 
 
function CreateFile(NameF : String) : Boolean;
{Создать файл}
Var
  Ok99 : Boolean;
  FF : file of byte;
begin
  {SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);}
  Result:= False;
  AssignFile(FF,NameF);
  {$I-} rewrite(FF) {$I+};
  Ok99:=(IoResult=0);
  if Ok99 then begin
     {$I-} CloseFile(FF) {$I+};
     Ok99:=(IoResult=0);
     Result := True;
  end;
end;
 
 
function GetFromFile0(NameF : String;
                      Var PBuf : Pointer;
                      StartByte, Count : LongInt) : Boolean;
{Прочитать количество байт из файла}
Var
  A : integer;
  Res : LongInt;
  Yes:byte;
  CountRec : LongInt;
  Ok99 : Boolean;
  FF : file;
  NumRead : Integer;
  NumWritten: integer;
  i : word;
 
begin
  {SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);}
  Yes:=0;
  Result := False;
  if (StartByte>=0) and (Count>0) then begin
     AssignFile(FF,NameF);
     if GetFAttrWithNameFile(NameF,A) then begin
        if SetFAttrWithNameFile(NameF,0) then begin
           {$I-} reset(FF,1) {$I+};
           Ok99:=(IoResult=0);
           if Ok99 then begin
              {$I-} CountRec:=FileSize(FF) {$I+};
              Ok99:=(IoResult=0);
              if Ok99 then begin
                 if (StartByte+Count-1) <= CountRec then begin
                    {$I-} seek(FF,StartByte) {$I+};
                    Ok99:=(IoResult=0);
                    if Ok99 then begin
                       {$I-} BlockRead(FF, PBuf^, Count, NumRead) {$I+};
                       Ok99:=(IoResult=0);
                       if Ok99 then begin
                          if Count= NumRead then begin
                             Yes:=1;
                          end;
                       end;
                    end;
                 end;
              end;
              {$I-} CloseFile(FF) {$I+};
              Ok99:=(IoResult=0);
           end;
           if Yes>0 then Result := True;
        end;
        SetFAttrWithNameFile(NameF,A);
     end;
  end;
end;
 
 
function PutToFile0(NameF : String;
                    Var PBuf : Pointer;
                    StartByte,Count : LongInt) : Boolean;
{Записать количество байт в файл}
Var
  A : integer;
  Res : LongInt;
  Yes:byte;
  CountRec : LongInt;
  Ok99 : Boolean;
  FF : file;
  NumRead : integer;
  NumWritten: integer;
  i : word;
 
begin
  {SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);}
  Yes:=0;
  Result := False;
  if (StartByte>=0) and (Count>0) then begin
     AssignFile(FF,NameF);
     if GetFAttrWithNameFile(NameF,A) then begin
        if SetFAttrWithNameFile(NameF,0) then begin
           {$I-} reset(FF,1) {$I+};
           Ok99:=(IoResult=0);
           if Ok99 then begin
              {$I-} CountRec:=FileSize(FF) {$I+};
              Ok99:=(IoResult=0);
              if Ok99 then begin
                 if (StartByte+Count-1) <= CountRec then begin
                    {$I-} seek(FF,StartByte) {$I+};
                    Ok99:=(IoResult=0);
                    if Ok99 then begin
                       {$I-} BlockWrite(FF, PBuf^, Count, NumRead) {$I+};
                       Ok99:=(IoResult=0);
                       if Ok99 then begin
                          if Count = NumRead then begin
                             Yes:=1;
                          end;
                       end;
                    end;
                 end;
              end;
              {$I-} CloseFile(FF) {$I+};
              Ok99:=(IoResult=0);
           end;
           if Yes>0 then Result := True;
        end;
        SetFAttrWithNameFile(NameF,A);
     end;
  end;
end;
 
 
function AppendToFile0(NameF : String;
                       Var PBuf : Pointer;
                       Count : LongInt) : Boolean;
{Дополнить количество байт в конец файл}
Var
  A : integer;
  Res : LongInt;
  Yes:byte;
  CountRec : LongInt;
  Ok99 : Boolean;
  FF : file;
  NumRead : integer;
  NumWritten: integer;
  i : word;
 
begin
  {SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);}
  Yes:=0;
  Result := False;
  if (Count>0) then begin
     AssignFile(FF,NameF);
     if GetFAttrWithNameFile(NameF,A) then begin
        if SetFAttrWithNameFile(NameF,0) then begin
           {$I-} reset(FF,1) {$I+};
           Ok99:=(IoResult=0);
           if Ok99 then begin
              {$I-} CountRec:=FileSize(FF) {$I+};
              Ok99:=(IoResult=0);
              if Ok99 then begin
                 {$I-} seek(FF,CountRec) {$I+};
                 Ok99:=(IoResult=0);
                 if Ok99 then begin
                    {$I-} BlockWrite(FF, PBuf^, Count, NumRead) {$I+};
                    Ok99:=(IoResult=0);
                    if Ok99 then begin
                       if Count= NumRead then begin
                          Yes:=1;
                       end;
                    end;
                 end;
              end;
              {$I-} CloseFile(FF) {$I+};
              Ok99:=(IoResult=0);
           end;
           if Yes>0 then Result := True;
        end;
        SetFAttrWithNameFile(NameF,A);
     end;
  end;
end;
 
 
 
 
function GetRecFromFile(NameF : String;
                        Var PBuf : Pointer;
                        NumRec,SizeRec : LongInt) : Boolean;
{Прочитать запись из файла по номеру}
begin
  Result := GetFromFile0(NameF,PBuf,NumRec*SizeRec,SizeRec);
end;
 
function PutRecToFile(NameF : String;
                      Var PBuf : Pointer;
                      NumRec,SizeRec : LongInt) : Boolean;
{Записать запись в файл}
begin
   Result := PutToFile0(NameF,PBuf,NumRec*SizeRec,SizeRec);
end;
 
function AppendRecToFile(NameF : String;
                         Var PBuf : Pointer;
                         SizeRec : LongInt) : LongInt;
{Дополнить запись в конец файла}
Var
  Yes : byte;
begin
  Result := -1;
  Yes:=1;
  if not FileExists(NameF) then begin
     if not CreateFile(NameF) then Yes:=0;
  end;
  if Yes>0 then begin
     if AppendToFile0(NameF,PBuf,SizeRec) then begin
        Result := CountRecInFile(NameF,SizeRec);
     end;
  end;
end;
 
 
 
end.

roamer · #6 07.05.2009, 17:18

Код:

Type
  PRec = ^TRec;
  TRec = record
           TabNum : integer;
           FIO    : string[64];
           Oklad  : real;
         end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
//Добавить запись в файл
Var
  PMyRec   : PRec;     //буфер для записи в файл
  TabNum   : integer;
  FileName : string;   //имя файла
begin
 
  FileName:=MainDir+'MyFile.dat';
  ListBox1.Items.Add('CountRec before: '+IntToStr(CountRecInFile(FileName, SizeOf(TRec))));
 
  //------------------------------------------------
  //блок подготовки данных для записи в файл
  TabNum:=CountRecInFile(FileName, SizeOf(TRec));
  if TabNum<0 then TabNum:=0;
  TabNum:=TabNum+1;
  //------------------------------------------------
 
  NEW(PMyRec); //Создаем дин.переменную
  TRY
     //-----------------------------------------
     //Записываем данные в буфер
     PMyRec^.TabNum := TabNum;
     PMyRec^.FIO    := 'FIO_'+IntToStr(TabNum);
     PMyRec^.Oklad  := TabNum*100+0.75;
     //-----------------------------------------
     AppendRecToFile(FileName,  POINTER(PMyRec), SizeOf(TRec)); //Сохраняем буфер в файл
  FINALLY
     Dispose(PMyRec);  //освобождаем ресурсы
  END;
  ListBox1.Items.Add('CountRec after: '+IntToStr(CountRecInFile(FileName, SizeOf(TRec))));
end;
 
procedure TForm1.LoadClick(Sender: TObject);
//Прочитать содержимое файла
Var
  PMyRec   : PRec;     //буфер для записи в файл
  iRec,CountRec : integer;
  FileName : string;   //имя файла
begin
  FileName:=MainDir+'MyFile.dat';
  CountRec:=CountRecInFile(FileName, SizeOf(TRec)); //определим кол-во записей в файле
  if CountRec>0 then begin
     ListBox1.Items.Clear; //сюда будем выводить данные
     NEW(PMyRec); //Создаем дин.переменную
     TRY
       for iRec:=0 to (CountRec-1) do
        begin
          GetRecFromFile(FileName, POINTER(PMyRec), iRec, SizeOf(TRec)); //Читаем из файла в буфер
          //--------------------------
          //Что-то делаем с этими данными
          ListBox1.Items.Add(IntToStr(iRec) + '.  '+IntToStr(PMyRec^.TabNum)+'  '+trim(PMyRec^.FIO)+'  '+FloatToStr(PMyRec^.Oklad));
          //--------------------------
       end;
     FINALLY
       Dispose(PMyRec);  //освобождаем ресурсы
     END;
  end;
end;

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты