diskio.pas

MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序； “MiniHex11SrcControls”目录中的是该软件

          if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
             (DIR_Entry.Name <> '..') then
             begin
                S := UpperCase(S);
                if S <> '' then
                   DIR_Entry.Name := DIR_Entry.Name+UpperCase(S) else
                   Delete(DIR_Entry.Name, Length(DIR_Entry.Name), 1);
             end;
          DIR_Entry.Attributes := P1^.deAttributes;
          if FFileSystem = fsFAT32 then
             begin
                DIR_Entry.StartCluster := P1^.deEAhandle;
                DIR_Entry.StartCluster := DIR_Entry.StartCluster shl 16;
                DIR_Entry.StartCluster := DIR_Entry.StartCluster+P1^.deStartCluster;
             end else DIR_Entry.StartCluster := P1^.deStartCluster;
          DIR_Entry.CreateTime := P1^.deCreateTime;
          DIR_Entry.CreateDate := P1^.deCreateDate;
          DIR_Entry.FileSize := P1^.deFileSize;
          DIR_Entry.LastAccessDate := P1^.deLastAccessDate;
          ADIR.Write(DIR_Entry, SizeOf(DIR_Entry));
          Stored := True;
          Inc(Longint(P1), SizeOf(TDIRENTRY));
       end;
   FreeMem(P);
   Entries := ADIR.Size div SizeOf(DIR_Entry);
   GetMem(DIR, ADIR.Size);
   ADIR.Seek(0, 0);
   ADIR.Read(DIR^, ADIR.Size);
   ADIR.Free;
   Result := True;
end;

function TDiskIO.ReadOtherDIR(Cluster: Longint; 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;
   Result := ReadClusterChain(Cluster, P, Size);
   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;
          if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
             (DIR_Entry.Name <> '..') then
             begin
                S := UpperCase(S);
                if S <> '' then
                   DIR_Entry.Name := DIR_Entry.Name+UpperCase(S) else
                   Delete(DIR_Entry.Name, Length(DIR_Entry.Name), 1);
             end;
          DIR_Entry.Attributes := P1^.deAttributes;
          if FFileSystem = fsFAT32 then
             begin
                DIR_Entry.StartCluster := P1^.deEAhandle;
                DIR_Entry.StartCluster := DIR_Entry.StartCluster shl 16;
                DIR_Entry.StartCluster := DIR_Entry.StartCluster+P1^.deStartCluster;
             end else DIR_Entry.StartCluster := P1^.deStartCluster;
          DIR_Entry.CreateTime := P1^.deCreateTime;
          DIR_Entry.CreateDate := P1^.deCreateDate;
          DIR_Entry.FileSize := P1^.deFileSize;
          DIR_Entry.LastAccessDate := P1^.deLastAccessDate;
          ADIR.Write(DIR_Entry, SizeOf(DIR_Entry));
          Stored := True;
          Inc(Longint(P1), SizeOf(TDIRENTRY));
       end;
   FreeMem(P);
   Entries := ADIR.Size div SizeOf(DIR_Entry);
   GetMem(DIR, ADIR.Size);
   ADIR.Seek(0, 0);
   ADIR.Read(DIR^, ADIR.Size);
   ADIR.Free;
   Result := True;
end;

function GetShortName(Name: String): String;
var S: String;
    I: Longint;
begin
   SetLength(S, 10000);
   I := GetShortPathName(PChar(Name), @S[1], 10000);
   SetLength(S, I);
   Result := S;
end;

procedure ParseFileName(FileName: String; Parsed: TStrings);
var STemp: String;
    S: String;
begin
   Parsed.Clear;
   if FileName = '' then Exit;
   STemp := ExpandFileName(FileName);
   STemp := UpperCase(GetShortName(STemp));
   if STemp = '' then Exit;
   S := STemp[1];
   Parsed.Add(S);
   Delete(STemp, 1, 3);
   repeat
     if Length(STemp) = 0 then Break;
     S := '';
     try
       while (Length(STemp)<>0) and (STemp[1]<>'\') do
         begin
            S := S+STemp[1];
            Delete(STemp, 1, 1);
         end;
     except
       on Exception do
          begin
             if Length(S)<>0 then Parsed.Add(S);
             Break;
          end;
     end;
     Parsed.Add(S);
     if Length(STemp) = 0 then Break;
     Delete(STemp, 1, 1);
   until False;
end;

function TDiskIO.DIRPath(Path: String; var DIR: PDIR_Entry; var Entries: Longint): Boolean;
var St: TStrings;
    S: String;
    I: Longint;
    J: Longint;
    D, D1: PDIR_Entry;
    DD: TDIR_Entry;
    L: Longint;
    B: Boolean;
begin
   Result := False;
   St := TStringList.Create;
   ParseFileName(Path, St);
   if St.Count = 0 then
      begin
         St.Free;
         Exit;
      end;
   Drive := St.Strings[0][1];
   if FFileSystem = fsNone then
      begin
         St.Free;
         Exit;
      end;
   if FFAT = NIL then
      begin
         St.Free;
         Exit;
      end;
   if FFATSize = 0 then
      begin
         St.Free;
         Exit;
      end;
   if not ReadRootDIR(D, L) then
      begin
         St.Free;
         Exit;
      end;
   if St.Count = 1 then
      begin
         DIR := D;
         Entries := L;
         Result := True;
         St.Free;
         Exit;
      end;
   for J := 1 to St.Count-1 do
       begin
          B := False;
          D1 := D;
          S := St.Strings[J];
          for I := 1 to L do
            if D1^.Name = S then
               begin
                  B := True;
                  Break;
               end else Inc(Longint(D1), SizeOf(TDIR_Entry));
          if not B then
             begin
                St.Free;
                FreeMem(D);
                Exit;
             end;
          DD := D1^;
          FreeMem(D);
          if DD.FileSize <> 0 then
             begin
                Result := True;
                Entries := 1;
                GetMem(DIR, SizeOf(TDIR_Entry));
                DIR^ := DD;
                St.Free;
                Exit;
             end;
          if not ReadOtherDIR(DD.StartCluster, D, L) then
             begin
                St.Free;
                Exit;
             end;
       end;
   Result := True;
   St.Free;
   Entries := L;
   DIR := D;
end;

function TDiskIO.ExtractDIREntry(Path: String; var DIR: TDIR_Entry): Boolean;
var St: TStrings;
    S: String;
    I: Longint;
    J: Longint;
    D, D1: PDIR_Entry;
    DD: TDIR_Entry;
    L: Longint;
    B: Boolean;
begin
   Result := False;
   St := TStringList.Create;
   ParseFileName(Path, St);
   if St.Count < 2 then
      begin
         St.Free;
         Exit;
      end;
   Drive := St.Strings[0][1];
   if FFileSystem = fsNone then
      begin
         St.Free;
         Exit;
      end;
   if FFAT = NIL then
      begin
         St.Free;
         Exit;
      end;
   if FFATSize = 0 then
      begin
         St.Free;
         Exit;
      end;
   if not ReadRootDIR(D, L) then
      begin
         St.Free;
         Exit;
      end;
   for J := 1 to St.Count-1 do
       begin
          B := False;
          D1 := D;
          S := St.Strings[J];
          for I := 1 to L do
            if D1^.Name = S then
               begin
                  B := True;
                  Break;
               end else Inc(Longint(D1), SizeOf(TDIR_Entry));
          if not B then
             begin
                St.Free;
                FreeMem(D);
                Exit;
             end;
          DD := D1^;
          FreeMem(D);
          if J = St.Count-1 then
             begin
                Result := True;
                DIR := DD;
                St.Free;
                Exit;
             end;
          if not ReadOtherDIR(DD.StartCluster, D, L) then
             begin
                St.Free;
                Exit;
             end;
       end;
end;

end.