⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 diskio.pas

📁 MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序; “MiniHex11SrcControls”目录中的是该软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
         for J := 0 to FFATCount-1 do
             begin
                P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+8);
                for I := 1 to FFATSize do
                    begin
                       L := Longint(P1^); Inc(Longint(P1), 4);
                       Longint(P2^) := L and FAT_MASK_32;
                       Inc(Longint(P2), 4);
                    end;
             end;
      end;
   FreeMem(P);
end;

function TDiskIO.GetFATEntry(CopyOfFAT: Longint; Cluster: Longint): Longint;
begin
   Result := -1;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if CopyOfFAT < 1 then CopyOfFAT := 1;
   if CopyOfFAT > FFATCount then CopyOfFAT := FFATCount;
   if Cluster < 2 then Cluster := 2;
   if Cluster > FEndingCluster then Cluster := FEndingCluster;
   Cluster := Cluster-2;
   CopyOfFAT := CopyOfFAT-1;
   Result := Longint(Pointer(Longint(FFAT)+CopyOfFAT*FFATSize*4+Cluster*4)^);
   if FFileSystem = fsFAT12 then Result := Result and FAT_MASK_12 else
   if FFileSystem = fsFAT16 then Result := Result and FAT_MASK_16 else
      Result := Result and FAT_MASK_32;
end;

procedure TDiskIO.SetFATEntry(CopyOfFAT: Longint; Cluster: Longint; Value: Longint);
begin
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if CopyOfFAT < 1 then CopyOfFAT := 1;
   if CopyOfFAT > FFATCount then CopyOfFAT := FFATCount;
   if Cluster < 2 then Cluster := 2;
   if Cluster > FEndingCluster then Cluster := FEndingCluster;
   Cluster := Cluster-2;
   CopyOfFAT := CopyOfFAT-1;
   if FFileSystem = fsFAT12 then Value := Value and FAT_MASK_12 else
   if FFileSystem = fsFAT16 then Value := Value and FAT_MASK_16 else
      Value := Value and FAT_MASK_32;
   Longint(Pointer(Longint(FFAT)+CopyOfFAT*FFATSize*4+Cluster*4)^) := Value;
end;

procedure TDiskIO.FlushFAT;
var P, P1, P2: Pointer;
    I, J: Longint;
    W: Word;
    L, L1, L2: Longint;
    B1, B2, B3, B4: Byte;
begin
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   GetMem(P, FSectorsPerFAT*FFATCount*FBytesPerSector);
   FillChar(P^, FSectorsPerFAT*FFATCount*FBytesPerSector, 0);
   P2 := FFAT;
   if FFileSystem = fsFAT12 then
      begin
         for J := 0 to FFATCount-1 do
             begin
                P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+3);
                Byte(Pointer(Longint(P1)-3)^) := $F8;
                Byte(Pointer(Longint(P1)-2)^) := $FF;
                Byte(Pointer(Longint(P1)-1)^) := $FF;
                for I := 1 to FFATSize div 2 do
                    begin
                       L1 := Longint(P2^)and FAT_MASK_12;
                       Inc(Longint(P2), 4);
                       L2 := Longint(P2^)and FAT_MASK_12;
                       Inc(Longint(P2), 4);
                       B1 := Byte(L1);
                       B2 := Byte(L1 shr 8) and $F;
                       B3 := Byte(L2 and $F) shl 4;
                       B4 := Byte(L2 shr 4);
                       B2 := B2 or B3;
                       Byte(P1^) := B1; Inc(Longint(P1));
                       Byte(P1^) := B2; Inc(Longint(P1));
                       Byte(P1^) := B4; Inc(Longint(P1));
                    end;
                if Odd(FFATSize) then
                   begin
                      L := Longint(P2^)and FAT_MASK_12;
                      Inc(Longint(P2), 4);
                      B1 := Byte(L);
                      B2 := Byte(L shr 8) and $F;
                      Byte(P1^) := B1; Inc(Longint(P1));
                      Byte(P1^) := B2; Inc(Longint(P1));
                   end;
             end;
      end else
   if FFileSystem = fsFAT16 then
      begin
         for J := 0 to FFATCount-1 do
             begin
                P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+4);
                Word(Pointer(Longint(P1)-4)^) := $FFF8;
                Word(Pointer(Longint(P1)-2)^) := $FFFF;
                for I := 1 to FFATSize do
                    begin
                       L1 := Longint(P2^)and FAT_MASK_16;
                       Inc(Longint(P2), 4);
                       W := Word(L1);
                       Word(P1^) := W; Inc(Longint(P1), 2);
                    end;
             end;
      end else
      begin
         for J := 0 to FFATCount-1 do
             begin
                P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+8);
                Longint(Pointer(Longint(P1)-8)^) := $FFFFFF8;
                Longint(Pointer(Longint(P1)-4)^) := $FFFFFFFF;
                for I := 1 to FFATSize do
                    begin
                       L := Longint(P2^)and FAT_MASK_32;
                       Inc(Longint(P2), 4);
                       Longint(P1^) := L; Inc(Longint(P1), 4);
                    end;
             end;
      end;
   WriteLogicalSector(FATSector[1], FSectorsPerFAT*FFATCount, P^, FBytesPerSector*FSectorsPerFAT*FFATCount);
   FreeMem(P);
end;

function TDiskIO.ReadCluster(Cluster: Longint; var Buffer; BufferSize: Longint): Boolean;
var P: Pointer;
    I: Longint;
begin
   Result := False;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if Cluster < 2 then Cluster := 2;
   if Cluster > FEndingCluster then Cluster := FEndingCluster;
   Cluster := Cluster-2;
   GetMem(P, FBytesPerSector*FSectorsPerCluster);
   I := FCluster2Sector+FSectorsPerCluster*Cluster;
   Result := ReadLogicalSector(I, FSectorsPerCluster, P^, FBytesPerSector*FSectorsPerCluster);
   if Result then Move(P^, Buffer, BufferSize);
   FreeMem(P);
end;

function TDiskIO.WriteCluster(Cluster: Longint; var Buffer; BufferSize: Longint): Boolean;
var P: Pointer;
    I: Longint;
begin
   Result := False;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if Cluster < 2 then Cluster := 2;
   if Cluster > FEndingCluster then Cluster := FEndingCluster;
   Cluster := Cluster-2;
   GetMem(P, FBytesPerSector*FSectorsPerCluster);
   FillChar(P^, FBytesPerSector*FSectorsPerCluster, 0);
   if BufferSize > FBytesPerSector*FSectorsPerCluster then
      BufferSize := FBytesPerSector*FSectorsPerCluster;
   Move(Buffer, P^, BufferSize);
   I := FCluster2Sector+FSectorsPerCluster*Cluster;
   Result := WriteLogicalSector(I, FSectorsPerCluster, P^, FBytesPerSector*FSectorsPerCluster);
   FreeMem(P);
end;

function TDiskIO.ValidCluster(Cluster: Longint): Boolean;
begin
   Result := (Cluster>=2) and (Cluster<=FEndingCluster);
end;

function TDiskIO.WriteClusterChain(StartCluster: Longint; Buffer: Pointer; BufferSize: Longint): Boolean;
var ClusterSize: Longint;
    I: Longint;
begin
   Result := False;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if StartCluster < 2 then StartCluster := 2;
   if StartCluster > FEndingCluster then StartCluster := FEndingCluster;
   ClusterSize := FBytesPerSector*FSectorsPerCluster;
   I := StartCluster;
   while ValidCluster(I) do
     begin
        if BufferSize<ClusterSize then
           begin
              Result := WriteCluster(I, Buffer^, BufferSize);
              Break;
           end else Result := WriteCluster(I, Buffer^, ClusterSize);
        if not Result then Break;
        Longint(Buffer) := Longint(Buffer)+ClusterSize;
        BufferSize := BufferSize-ClusterSize;
        I := FATEntry[1, I];
     end;
end;

function TDiskIO.ReadClusterChain(StartCluster: Longint; var Buffer: Pointer; var BufferSize: Longint): Boolean;
var I, J: Longint;
    P: Pointer;
    F: TMemoryStream;
    B: Boolean;
begin
   Result := False;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if StartCluster < 2 then StartCluster := 2;
   if StartCluster > FEndingCluster then StartCluster := FEndingCluster;
   I := StartCluster;
   J := FBytesPerSector*FSectorsPerCluster;
   GetMem(P, J);
   F := TMemoryStream.Create;
   repeat
     if not ValidCluster(I) then Break;
     B := ReadCluster(I, P^, J);
     if not B then
        begin
           Result := False;
           Break;
        end;
     Result := True;
     F.Write(P^, J);
     I := FATEntry[1, I];
   until False;
   FreeMem(P);
   Buffer := NIL;
   BufferSize := 0;
   if Result then
      begin
         BufferSize := F.Size;
         GetMem(Buffer, BufferSize);
         F.Seek(0, 0);
         F.Read(Buffer^, BufferSize);
      end;
   F.Free;
end;

function TDiskIO.SeekForChainStart(Cluster: Longint): Longint;
var I, J: Longint;
    B: Boolean;
begin
   Result := -1;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if Cluster < 2 then Cluster := 2;
   if Cluster > FEndingCluster then Cluster := FEndingCluster;
   J := -1;
   repeat
     B := False;
     for I := 2 to FEndingCluster do
         if FATEntry[1, I] = Cluster then
            begin
               J := I;
               Cluster := I;
               B := True;
               Break;
            end;
   until not B;
   Result := J;
end;

function TDiskIO.ReadRootDIR(var DIR: PDIR_Entry; var Entries: Longint): Boolean;
var P: Pointer;
    P1: PDIREntry;
    PL: PLONGDIRENTRY;
    Size: Longint;
    ADIR: TMemoryStream;
    I, J: Longint;
    Dir_Entry: TDIR_Entry;
    Stored: Boolean;
    S: String;
    SZ: Array[0..10] of WideChar;
begin
   Result := False;
   if FFileSystem = fsNone then Exit;
   if FFAT = NIL then Exit;
   if FFATSize = 0 then Exit;
   if FFileSystem = fsFAT32 then Result := ReadClusterChain(2, P, Size) else
      begin
         Size := ((FRootDirEntries*32+FBytesPerSector-1) div FBytesPerSector)*FBytesPerSector;
         GetMem(P, Size);
         Result := ReadLogicalSector(FRootDirSector, Size div FBytesPerSector, P^, Size);
         if not Result then FreeMem(P);
      end;
   if not Result then Exit;
   Size := Size div 32;
   ADIR := TMemoryStream.Create;
   P1 := P;
   Stored := True;
   for I := 1 to Size do
       begin
          if Stored then
             begin
                Stored := False;
                FillChar(DIR_Entry, SizeOf(DIR_Entry), 0);
             end;
          if Byte(Pointer(P1)^) = $e5 then DIR_Entry.Erased := True else DIR_Entry.Erased := False;
          if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
             (Byte(Pointer(Longint(P1)+$0c)^) = 0) then
             begin
                PL := PLONGDIRENTRY(P1);
                if (PL^.leName[1] <> WideChar(0)) and (PL^.leName[1] <> WideChar($FFFF)) then
                   begin
                      FillChar(SZ, SizeOf(SZ), 0);
                      for J := 1 to 5 do SZ[J-1] := PL^.leName[J];
                      S := WideCharToString(SZ);
                   end else S := '';
                if (PL^.leName2[1] <> WideChar(0)) and (PL^.leName2[1] <> WideChar($FFFF)) then
                   begin
                      FillChar(SZ, SizeOf(SZ), 0);
                      for J := 1 to 6 do SZ[J-1] := PL^.leName2[J];
                      S := S+WideCharToString(SZ);
                   end;
                if (PL^.leName3[1] <> WideChar(0)) and (PL^.leName3[1] <> WideChar($FFFF)) then
                   begin
                      FillChar(SZ, SizeOf(SZ), 0);
                      for J := 1 to 2 do SZ[J-1] := PL^.leName3[J];
                      S := S+WideCharToString(SZ);
                   end;
                if DIR_Entry.LongName = '' then DIR_Entry.LongName := S else
                   Insert(S, DIR_Entry.LongName, 1);
                Inc(Longint(P1), SizeOf(TDIRENTRY));
                Continue;
             end;
          if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
             (Byte(Pointer(Longint(P1)+$0c)^) <> 0) then
             begin
                Stored := True;
                Inc(Longint(P1), SizeOf(TDIRENTRY));
                Continue;
             end;
          S := '';
          for J := 1 to 8 do S := S+P1^.deName[J];
          try
            while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0)) do
                  Delete(S, Length(S), 1);
          except
            on Exception do;
          end;
          DIR_Entry.Name := UpperCase(S);
          if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
             (DIR_Entry.Name <> '..') and ((P1^.deAttributes and $08) = 0) then DIR_Entry.Name := DIR_Entry.Name+'.';
          S := '';
          for J := 1 to 3 do S := S+P1^.deExtension[J];
          try
            while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0)) do
                  Delete(S, Length(S), 1);
          except
            on Exception do;
          end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -