Delphi中利用File Of Type创建并维护类数据库型二进制记录文档

清疚 2023-10-06 10:42 7阅读 0赞

话不多说，直接上代码：

//定义存储数据结构
    type
      TStudent = record
        ID:      Integer;
        Age:     Integer;
        Name:    string[10];
        Email:   string[50];
        Sex:     string[5];
        Address: string[100];
      end;
    
    const sFile ='student.stu';  //存储文件名
    
    
    var
      Form1: TForm1;
      stu: TStudent;
    
    implementation
    
    {$R *.dfm}
    
    
    
    //初始化生成10条记录并以二进制写入文件保存
    procedure TForm1.btnInitDataClick(Sender: TObject);
    var
      F: file of TStudent;    //file of type type必须是固定大小的，不能是对象, String, Variant等
      Students: array[1..10] of TStudent;
      i: Integer;
    begin
      try
        AssignFile(F, sFile);
        //Rewrite(文件变量名);若无该文件，则创建文件，若有该文件，覆盖掉原文件。
        Rewrite(F);
        Randomize;//初始化随机种子,生成随机年龄
        for i := 1 to 10  do
        begin
          Students[i].ID := 100+i;
          Students[i].Age := random(15)+10;   //随机10-25以内的数字
          Students[i].Name := 'Name' + IntToStr(i);
          Students[i].Email := 'Email' + IntToStr(i);
          if Odd(i) then    //随机性别，奇数为男，偶数为女
            Students[i].Sex := '男'
          else
            Students[i].Sex := '女';
          Students[i].Address := '这是测试地址' + IntToStr(i);
          Write(F, Students[i]);
        end;
      except
        on E: Exception do
          ShowMessage(E.Message);
      end;
      CloseFile(F);
    end;
    
    //读取记录
    function ReadRec(RecNo:integer; RecFileName: string; var Rec:TStudent):boolean;
    var
      F: file of TStudent;
    begin
      AssignFile(F,RecFileName) ;
      Reset(F) ;
      try
        Seek(F,RecNo-1);  //用户要提取第一个就输入1，类推
        Read(F, Rec);
        Result := True;
        Form1.Label7.Caption:='共有记录数'+IntToStr(FileSize(F))+'条';
      Except
        Result := False;
      end;
      CloseFile(F);
    end;
    
    
    //新增记录在记录文件结尾
    procedure InsertRec_Last(NewRec: TStudent; RecFileName: string);
    var
      F: file of TStudent;
      RecCount: integer;//Rec数量
    begin
      AssignFile(F, RecFileName);
      if not FileExists(RecFileName) then
      begin
        Rewrite(F);
        Write(F, NewRec);
      end
      else
      begin
       // FileMode := 1;//设置成WriteOnly模式
        Reset(F);   //存在则添加Rec入文件
        RecCount := FileSize(F);//取Rec数量
        Seek(F, RecCount);//设置Pointer位置
        Write(F, NewRec);
       end;
      CloseFile(F);
    end;
    
    {----新增记录在指定记录位置后 -------
    需要使用的方法 
    Seek(f, RecNo);　　 //RecNo代表要定位置的记录编号
    Write(f, FileRec)
    基本思路：
    获取指定记录的位置，并把该位置后的记录逐个向后移动 }
    procedure InsertRec_Index(const RecNo:Integer; NewRec: TStudent; RecFileName: string);
    var
      F: file of TStudent;
      RecCount,ni: integer;//Rec数量
      FileRec:TStudent;
    begin
      AssignFile(F, RecFileName);
      if FileExists(RecFileName) then
      begin
        Reset(F);
        RecCount := FileSize(F);  //取Rec数量
        if (RecNo>RecCount) or (RecNo<0) then
           Exit;
        for ni := RecCount-1  downto RecNo do
        begin
          Seek(F,ni);
          read(F,FileRec);
          Seek(F,ni+1);
          write(F,FileRec);
        end;
        Seek(F,RecNo);
        Write(F, NewRec);
       end;
      CloseFile(F);
    end;
    
    
    {----删除记录在指定位置 -------
    需要使用的方法 
    Seek(f, RecNo); 　　//RecNo代表要定位置的记录编号
    Write(f, FileRec)
    Truncate(f) ;　　　//删除指定索引号之后的索引文件
    基本思路：
    获取指定位置，并把该位置后的记录逐个向前移动。 文件在最后一条记录前截断。
    删除指定索引号的记录 }
    procedure DeleteRec_Index(const RecNo:Integer; RecFileName: string);
    var
      F: file of TStudent;
      RecCount,ni: integer;
      FileRec:TStudent;
    begin
      AssignFile(F, RecFileName);
      if FileExists(RecFileName) then
      begin
        Reset(F);
        RecCount := FileSize(F);  //取Rec数量
        if (RecNo>RecCount) or (RecNo<=0) then
           Exit;
        for ni := RecNo   to RecCount-1 do
        begin
          Seek(F,ni);
          read(F,FileRec);
          Seek(F,ni - 1);
          write(F,FileRec);
        end;
        Seek(F,RecCount-1);
        Truncate(F);
      end;
      CloseFile(F);
    end;
    
    //更新指定记录
    procedure UpdateRec(RecNo: Integer; RecFileName: string);
    var
      F: file of TStudent;
      RecCount: integer;//Rec数量
    begin
      AssignFile(F, RecFileName);
      if  FileExists(RecFileName) then
      begin
       // FileMode := 1;//设置成WriteOnly模式
        Reset(F);
        RecCount := FileSize(F);//取Rec数量
        if RecNo<=RecCount then
        begin
          Seek(F, RecNo-1);//设置Pointer位置
          stu.ID:=StrToInt(Form1.edtID.Text);
          stu.Age:=StrToInt(Form1.edtAge.Text);
          stu.Name:=Form1.edtName.Text;
          stu.Email:=Form1.edtEmail.Text;
          stu.Sex:=Form1.edtSex.Text;
          stu.Address:=Form1.edtAddress.Text;
          Write(F,stu);
        end;
        CloseFile(F);
      end;
    end;

测试程序效果如下图：

![watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3doNDQ1MzA2_size_16_color_FFFFFF_t_70][]

**代码编译适用环境:**

any,经测试在Delphi7,Delphi2007,DelphiXE2均正常

**说明：原创代码文章，转载请注明出处！谢谢**

[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3doNDQ1MzA2_size_16_color_FFFFFF_t_70]: https://img-blog.csdnimg.cn/20200608101352130.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3doNDQ1MzA2,size_16,color_FFFFFF,t_70