unit wincpm;

{$mode objfpc}{$H+}

interface


uses

  SysUtils,
  Classes,
  Ultibo;



const
  max_BlockFeld_len = 2047;
  Pfadtrenner = '\';



type


  T_DPB = record
            SPT, { Sectors per Logical Track - Sektoren pro Spur (72) }
            BSH, { Block Shift - Blockverschiebungsfaktor = Blockgroesse / 128 (4) }
            BLM, { Block Mask - Blockmaske (15) }
            EXM, { Extent Mask - Extendmaske (0) }
            DSM, { Highest Block Number - Anzahl der Bloecke pro Diskette minus 1 plus Verzeichnis minus Systemspuren (710) }
            DRM, { Highest Directory Entry Number - Anzahl der Verzeichniseintraege minus 1 (255) }
            AL0, AL1, { 16-bit Directory Allocation Pattern - vom Verzeichnis belegte Boecke (0F000H) }
            CKS, { Directory Check Sum - Groesse des Verzeichnispruefvektors (64) }
            OFF  { No. of reserved tracks - Anzahl der Systemspuren (2) }
            : Integer;
         end;


  T_DIR_Entry = record
                  UserNumber : Byte; // 0
                  filename : Array [1..8] of Byte; //  1..8
                  filetype : Array [1..3] of Byte;  // 9..11
                  EX, S2, S1, RC : Byte;  // 12..15
                  AL : Array[1..8] of Word;
                end;


  T_BlockEntry = class(TObject)
                   BlockNumber, RecordCounter : Word;
                 end; { T_BlockList }


  T_DIR_Set = class(TObject)
                UserNumber : Byte;
                filename : String[8]; // Array [1..8] of Char;
                filetype : String[3]; // Array [1..3] of Char;
                ATTR : Array [1..11] of Boolean;
                RecordCount : Word;
                BlockList : TList;
              end; { T_DIR_Set }


  { Twcpm }

  Twcpm = class(TObject)
    constructor Create(CPM_DIR_Laufwerk : String);
    destructor Destroy; override;
   private
    { private declarations }
    Blockanzahl : Integer;
    CPM_DIR_List, WIN_DIR_List : TStringList;
    Blockgroesse : Integer;
    DIR_Entry_List : TList;
    BlockFeld : Array [0..max_BlockFeld_len] of Char;


    { allgemein }
    procedure create_IMG_File;
    procedure calculate_Blockgroesse;

    { WIN_To_CPM }
    procedure WIN_DIR_To_WIN_DIR_List;
    procedure Format_CPM_File_Name(var F_Name, F_Type : String;
                                   FileName : String);
    procedure Copy_WIN_Files_To_Image;

    { CPM_To_WIN }
    procedure CPM_DIR_List_To_CPM_File;
    procedure Dir_Entrys_To_DIR_Entry_List;
    procedure DIR_Entry_List_To_CPM_DIR_List;




  public
    { public declarations }

    IMG_File : TMemoryStream;
    DPB : T_DPB;
    WIN_DIR_Pfad : String;

    { allgemein }
    procedure load_dpb_FormatE_8MB;

    { WIN_To_CPM }
    procedure Import_Files_To_Image;

    { CPM_To_WIN }
    procedure Export_Files_From_Image;


  end;





var
  wcpm_Drive : Twcpm;



implementation


   {
uses
  CPM_Screen;

      }

constructor Twcpm.Create(CPM_DIR_Laufwerk : String);
begin
  inherited Create;

  WIN_DIR_Pfad:=CPM_DIR_Laufwerk;

end; { constructor Twcpm.Create }



{ *** allgemeine Prozeduren *** }



procedure Twcpm.create_IMG_File;
var
  x1, Dateigroesse : Integer;
  Buffer : Byte;
begin
  // die
  Dateigroesse := ((DPB.DSM+1)*Blockgroesse) + (DPB.SPT*DPB.OFF*128);

  IMG_File.SetSize(Dateigroesse);
  IMG_File.Position:=0;
  Buffer:=$E5;
  for x1:=0 to Dateigroesse-1 do begin
    IMG_File.Write(Buffer,1);
  end;
  Blockanzahl:=DPB.DSM+1;


end; { procedure Twcpm.create_IMG_File }





procedure Twcpm.calculate_Blockgroesse;
begin

  case DPB.BSH of
    3 : Blockgroesse:=1024;
    4 : Blockgroesse:=2048;
    5 : Blockgroesse:=4096;
    6 : Blockgroesse:=8192;
    7 : Blockgroesse:=16384;
  end;

end; { procedure Twcpm.calculate_Blockgroesse }





// Format fuer Laufwerke C, D, E
// 800000H
procedure Twcpm.load_dpb_FormatE_8MB;
begin
{
; Disketten Parameter Block (DPB2)
; ===============================
DW 128 ;SPT - 128 bytes sectors per track (= 32 sectors of 512 bytes)
DB 5   ;BSH - block shift factor
DB 31  ;BLM - block mask
DB 1   ;EXM - Extent mask
DW 2047 ;DSM - Storage size (blocks - 1)
DW 511 ;DRM - Number of directory entries - 1
DB 240 ;AL0 - 1 bit set per directory block
DB 0   ;AL1 -            "
DW 0   ;CKS - DIR check vector size (DRM+1)/4 (0=fixed disk)
DW 0   ;OFF - Reserved tracks
}

  DPB.SPT:=128;  DPB.BSH:=5;   DPB.BLM:=31;  DPB.EXM:=1;   DPB.DSM:=2048-1;
  DPB.DRM:=512-1; DPB.AL0:=240; DPB.AL1:=$00; DPB.CKS:=0;  DPB.OFF:=0;

  calculate_Blockgroesse;
end; { procedure Twcpm.load_dpb_FormatE_8MB }








{ ***** WINDIR TO CPM-Image ***** }




procedure Twcpm.Import_Files_To_Image;
begin

  WIN_DIR_List := TStringList.Create;
  DIR_Entry_List := TList.Create;
  IMG_File := TMemoryStream.Create;

  // Erzeugen des Images
  create_IMG_File;

  while not DirectoryExists('C:\') do begin
    {Sleep for a second}
    Sleep(500);
  end;

  if not DirectoryExists(WIN_DIR_Pfad) then
    CreateDir(WIN_DIR_Pfad);

  // Einlesen der Dateiliste
  WIN_DIR_To_WIN_DIR_List;

  if WIN_DIR_List.Count>0 then begin

    Copy_WIN_Files_To_Image;

  end; { if WIN_DIR_List.Count>0 then }

//  WIN_DIR_List.Free;
//  DIR_Entry_List.Free;

end; { procedure Twcpm.Import_Files_To_Image }




procedure Twcpm.WIN_DIR_To_WIN_DIR_List;
{ Liest alle Einträge des Windows-Verzeichnisses CPM_LW_A in die
  StringListe WIN_DIR_List ein.
}
var
  SearchRec:TSearchRec;
  FileName:String;

begin
  WIN_DIR_List.Clear;

  {To list the contents we need to use FindFirst/FindNext, start with FindFirst}
  if FindFirst(WIN_DIR_Pfad+Pfadtrenner+'*.*',faAnyFile,SearchRec) = 0 then begin
    {If FindFirst succeeds it will return 0 and we can proceed with the search}
    repeat
      {Print the file found to the screen}
      FileName := UpperCase(SearchRec.Name);
      if FileName[1]<>'.' then begin
        WIN_DIR_List.Add(FileName);
      end;

    {We keep calling FindNext until there are no more files to find}
    until FindNext(SearchRec) <> 0;

  end; { if FindFirst(WIN_DIR_Pfad+Pfadtrenner... }

  {After any call to FindFirst, you must call FindClose or else memory will be leaked}
  FindClose(SearchRec);

                    {
  FileName:='C:\WIN_DIR_List.txt';
  if FileExists(FileName) then begin
    DeleteFile(PChar(FileName));
  end;
  WIN_DIR_List.SaveToFile(FileName);
                    }

end; { procedure Twcpm.WIN_DIR_To_WIN_DIR_List }








procedure Twcpm.Format_CPM_File_Name(var F_Name, F_Type : String;
                                     FileName : String);
var
  Pos_Punkt : Integer;
begin
    // Umwandeln des Dateinamens
    FileName:=Trim(FileName);

    F_Name:=FileName;
    F_Type:='   ';

    Pos_Punkt:=Pos('.',FileName);
    if Pos_Punkt>0 then begin
      F_Name:=Copy(FileName,1,Pos_Punkt-1);
      F_Type:=Copy(FileName,Pos_Punkt+1,Length(FileName)-1);
    end;

    while Length(F_Name)<8 do
      F_Name:=F_Name+' ';

    while Length(F_Type)<3 do
      F_Type:=F_Type+' ';

end; { procedure Twcpm.Format_CPM_File_Name }





procedure Twcpm.Copy_WIN_Files_To_Image;
{
  Kopiert alle Windows-Dateien, die in der StringList WIN_DIR_List stehen
  in das CPM-Image
}
var
  CopyName : String;
  WIN_File : TMemoryStream;
  WIN_DIR_List_Counter : Integer;


  procedure Free_BlockList;
  // schreibt in das Array BlockFeld alle Bloecke mit Leer(x), Block vorhanden(f),
  // Dir(d) und Belegt(b)
  var
    DIR_Set : T_DIR_Set;
    BlockEntry : T_BlockEntry;
    Zaehler_DEL, Zaehler_BL, Anzahl_Sys : Integer;
  begin
    // erst einmal werden alle Elemente im Array mit "x" beschrieben
    for Zaehler_BL:=0 to max_BlockFeld_len do
      BlockFeld[Zaehler_BL]:='x';

    // dann werden alle Elemente, die wirklich als Bloecke genutzt werden
    // mit "f"=frei gekennzeichnet (ohne Systemspuren)
    for Zaehler_BL:=0 to Blockanzahl-1 do
      BlockFeld[Zaehler_BL]:='f';

    Zaehler_DEL:=((DPB.DRM+1) div (Blockgroesse div 32));

    // das Direktory wird mit "d" gekennzeichnet
    for Zaehler_BL:=0 to Zaehler_DEL-1 do
      BlockFeld[Zaehler_BL]:='d';

    // die belegten Bloecke werden mit "b" gekennzeichnet
    for Zaehler_DEL:=0 to DIR_Entry_List.Count-1 do begin
      DIR_Set:=T_DIR_Set(DIR_Entry_List[Zaehler_DEL]);

      for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do begin
        BlockEntry:=T_BlockEntry(DIR_Set.BlockList[Zaehler_BL]);
        BlockFeld[Anzahl_Sys+BlockEntry.BlockNumber]:='b';
      end; { for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do }

    end; { for Zaehler:=0 to DPB.DRM do }
  end; { procedure Free_BlockList }



  function Find_Next_Free_Block : Integer;
  // sucht und uebergibt den nächsten freien Block und kennzeichnet
  // ihn als besetzt
  var
    Next_Free_Block, Zaehler_BL : Integer;
    gefunden : Boolean;
  begin
    gefunden:=false;
    Next_Free_Block:=0;
    for Zaehler_BL:=0 to Blockanzahl-1 do begin
      if (not gefunden) then begin
        if BlockFeld[Zaehler_BL]='f' then begin
          BlockFeld[Zaehler_BL]:='b';
          gefunden:=true;
          Next_Free_Block:=Zaehler_BL;
        end; { if BlockFeld[Zaehler_BL]='f' then }
      end; { if (not gefunden) then }
    end; { for Zaehler_BL:=0 to Blockanzahl-1 do }

    Result:=Next_Free_Block;
  end; { function Find_Next_Free_Block }



  procedure Write_File(FileName : String);
  var
    Zaehler_F,
    Records_per_Block, Records_per_File,
    Record_Counter, DIR_Anfang, Zaehler_DRM,
    DIR_POS_schreiben, geschriebene_Records : Integer;
    F_Name, F_Type : String;
    First_Block_Pos, akt_Block_Pos, akt_Block_Nr, Write_Size : DWord;
    Buffer : Array [1..16384] of Byte;
    Extendnummer, Extendgruppe : Byte;
    BlockList : TList;
    BlockEntry : T_BlockEntry;
    DIR_Entry : T_DIR_Entry;
    DIR_Entry_ready : Boolean;
    ein_Byte : Byte;
    Groesse : Int64;



  begin
    BlockList := TList.Create;


    Groesse:=WIN_File.Size;

    if (Groesse mod 128)>0 then begin
      ein_Byte:=$1A;
      WIN_File.Position:=Groesse;
      while (Groesse mod 128)>0 do begin
        WIN_File.Write(ein_Byte,1);
        Groesse:=WIN_File.Size;
      end; { while (Groesse mod 128)>0 do }

      WIN_File.Position:=0;

    end; { if (Groesse mod 128)>0 then }



    // Berechnung der Anzahl der Bloecke aus der Win-Dateigroesse
    Records_per_File := WIN_File.Size div 128;

    // ist der nächste Block angerissen (z.B. bei Textdateien, die in Windows
    // editiert wurden - Windows speichert nicht in 128er Sektoren ab), so wird
    // ein Sektor hinzugezaehlt
    // if (WIN_File.Size mod 128)>0 then begin
    //   inc(Records_per_File);
    // end;

    Record_Counter := Records_per_File;
    Records_per_Block := Blockgroesse div 128;

    Format_CPM_File_Name(F_Name, F_Type, FileName);

    // es wird an der ersten Blockposition angefangen
    // die ergibt sich aus der Laenge des Systemabschnittes am Anfang
    // des Images


    First_Block_Pos:= DPB.SPT*DPB.OFF*128;
    // Blockgroesse=4096, 6 Spuren, 32 Sekt/Spur, 6*32*128=24576,  24576/Blockgroesse=6
    // Blockgroesse=2048, 2 Spuren, 72 Sekt/Spur, 2*72*128=18432,  18432/Blockgroesse=9


    WIN_File.Position:=0;

    // solange nicht alle Records geschrieben wurden, wird weiter geschrieben
    while Record_Counter>0 do begin

      // ein neuer Eintrag für BlockEntry wird erzeugt
      BlockEntry := T_BlockEntry.Create;

      if Record_Counter>Records_per_Block then begin
        Record_Counter:=Record_Counter-Records_per_Block;
        Write_Size:=Blockgroesse;
        BlockEntry.RecordCounter:=Records_per_Block;
      end
      else begin
        Write_Size:=Record_Counter*128;
        BlockEntry.RecordCounter:=Record_Counter;
        Record_Counter:=0;
      end;

      // Aus der Windows-Datei wird der Inhalt eines Blockes (oder eines Sektors * x)
      // in den Buffer gelesen
      WIN_File.Read(Buffer,Write_Size);

      akt_Block_Nr := Find_Next_Free_Block;
      akt_Block_Pos := akt_Block_Nr * Blockgroesse;
      IMG_File.Position:=First_Block_Pos + akt_Block_Pos;

      // nun wird der Buffer in das Image geschrieben
      IMG_File.Write(Buffer,Write_Size);

      // und dann die aktuelle Blocknummer dort hineingeschrieben
      BlockEntry.BlockNumber:=akt_Block_Nr;
      // und den BlockEntry in die BlockList geschrieben
      BlockList.Add(BlockEntry);

    end; { while Record_Counter>Records_per_Block do }


    DIR_Anfang := DPB.SPT*DPB.OFF*128;
    // Blockgroesse=4096, 6 Spuren, 32 Sekt/Spur, 6*32*128=24576,  24576/Blockgroesse=6
    // Blockgroesse=2048, 2 Spuren, 72 Sekt/Spur, 2*72*128=18432,  18432/Blockgroesse=9
    IMG_File.Position:=DIR_Anfang;

    DIR_Entry_ready:=false;
    Extendnummer:=0;
    Extendgruppe:=0;
    geschriebene_Records:=0;



    for Zaehler_DRM:=0 to DPB.DRM do begin
      while not DIR_Entry_ready do begin
        DIR_POS_schreiben:=IMG_File.Position;
        IMG_File.Read(DIR_Entry, 32);

        if (DIR_Entry.UserNumber=$E5) then begin // E5H bedeutet der Eintrag ist nicht belegt
                                                // oder geloescht

          DIR_Entry.UserNumber:=$00;
          for Zaehler_F:=1 to 8 do
            DIR_Entry.filename[Zaehler_F]:=Byte(F_Name[Zaehler_F]);

          for Zaehler_F:=1 to 3 do
            DIR_Entry.filetype[Zaehler_F]:=Byte(F_Type[Zaehler_F]);



          // solange in der BlockList Eintraege (mit Blocknummern) vorhanden
          // sind, werden diese Blocknummern gelesen und in DIR_Entry.AL
          // eingetragen (maximal aber 8 Einträge)
          for Zaehler_F:=1 to 8 do begin
            if BlockList.Count>0 then begin
              // lesen des naechsten BlockEntry-Eintrages
              BlockEntry:=T_BlockEntry(BlockList.Items[0]);
              // Abspeichern der Blocknummer in der DIR_Entry.AL-Struktur (1..8)
              DIR_Entry.AL[Zaehler_F]:=BlockEntry.BlockNumber;
              // merken, wie viele Records bisher in diesem Verzeichniseitrag
              // geschrieben wurden
              geschriebene_Records:=geschriebene_Records+BlockEntry.RecordCounter;
              // Löschen des BlockEntry-Eintrages
              BlockList.Delete(0);
            end  { if BlockList.Count>0 then }
            else
              DIR_Entry.AL[Zaehler_F]:=$0000;

          end; { for Zaehler_F:=1 to 8 do }


          if BlockList.Count=0 then
            DIR_Entry_ready:=true;


          // die geschriebenen Records werden auf RC, EX und S2 aufgeteilt
          while geschriebene_Records>128 do begin
            geschriebene_Records:=geschriebene_Records-128;
            Inc(Extendnummer);
            if Extendnummer=32 then begin
              Inc(Extendgruppe);
              Extendnummer:=0;
            end; { if Extendnummer=32 then }
          end; { while geschriebene_Records>128 do }


          // ... und eingetragen
          DIR_Entry.EX:=Extendnummer;
          DIR_Entry.S2:=Extendgruppe;
          DIR_Entry.S1:=$0;
          DIR_Entry.RC:=geschriebene_Records;

          IMG_File.Position:=DIR_POS_schreiben;
          IMG_File.Write(DIR_Entry, 32);

        end; { if (DIR_Entry.UserNumber=$E5) then }
      end; { while not DIR_Entry_ready do }

    end; { for Zaehler:=0 to DPB.DRM do }

  end; { procedure Read_File }





begin
  { 256 VE * 32 Byte = 8192 Byte = 4 Bloecke }

  { 6800H = Block 4 }


  if WIN_DIR_List.Count>0 then begin

    WIN_File := TMemoryStream.Create;
    Free_BlockList;

    for WIN_DIR_List_Counter:=0 to WIN_DIR_List.Count-1 do begin

      CopyName:=WIN_DIR_List[WIN_DIR_List_Counter];
      CopyName:=Trim(CopyName);
      WIN_File.LoadFromFile(WIN_DIR_Pfad+Pfadtrenner+CopyName);
      Write_File(CopyName);

    end; { for WIN_DIR_List_Counter:=0 to WIN_DIR_List.Count-1 do }

  end; { if ListBox_CPM_DIR.Count>0 then }

  WIN_File.Free;

  {
  IF DPB.SPT=32 THEN
    IMG_File.SaveToFile('LW_B.IMG');
     }

end; { procedure Twcpm.Copy_WIN_Files_To_Image }





{ ***** CPM-Image TO WINDIR ***** }






procedure Twcpm.Export_Files_From_Image;
begin

    CPM_DIR_List := TStringList.Create;
    DIR_Entry_List := TList.Create;

    Dir_Entrys_To_DIR_Entry_List;
    DIR_Entry_List_To_CPM_DIR_List;
    CPM_DIR_List_To_CPM_File;
                 {
    CPM_DIR_List.Free;
    DIR_Entry_List.Free;
                     }
end; { procedure Twcpm.Export_Files_From_Image }






procedure Twcpm.Dir_Entrys_To_DIR_Entry_List;
{
  Die Einträge des Inhaltsverzeichnisses des Images werden in die Struktur
  DIR_Entry : T_DIR_Entry eingelesen.
}
  var
    DIR_Entry : T_DIR_Entry;
    DIR_Set : T_DIR_Set;
    BlockEntry : T_BlockEntry;
    DIR_Anfang, logische_Erweiterung : Word;
    Zaehler_DRM, Zaehler_AL : Integer;
    filename : String; // Array [1..8] of Char;
    filetype : String; // Array [1..3] of Char;
    erster_Durchlauf : Boolean;
    Anzahl_der_Eintraege : Integer;


    procedure Grundeintrag;
    begin
      DIR_Set.BlockList := TList.Create;

      DIR_Set.UserNumber:=DIR_Entry.UserNumber;
      DIR_Set.filename:=filename;
      DIR_Set.filetype:=filetype;

      DIR_Set.ATTR[01]:=((DIR_Entry.filename[1] and $80)=$80);
      DIR_Set.ATTR[02]:=((DIR_Entry.filename[2] and $80)=$80);
      DIR_Set.ATTR[03]:=((DIR_Entry.filename[3] and $80)=$80);
      DIR_Set.ATTR[04]:=((DIR_Entry.filename[4] and $80)=$80);
      DIR_Set.ATTR[05]:=((DIR_Entry.filename[5] and $80)=$80);
      DIR_Set.ATTR[06]:=((DIR_Entry.filename[6] and $80)=$80);
      DIR_Set.ATTR[07]:=((DIR_Entry.filename[7] and $80)=$80);
      DIR_Set.ATTR[08]:=((DIR_Entry.filename[8] and $80)=$80);
      DIR_Set.ATTR[09]:=((DIR_Entry.filetype[1] and $80)=$80);
      DIR_Set.ATTR[10]:=((DIR_Entry.filetype[2] and $80)=$80);
      DIR_Set.ATTR[11]:=((DIR_Entry.filetype[3] and $80)=$80);

    end; { procedure Grundeintrag }


  begin
    DIR_Entry_List.Clear;
    Anzahl_der_Eintraege:=0;

    DIR_Anfang := DPB.SPT*DPB.OFF*128;
    // Blockgroesse=4096, 6 Spuren, 32 Sekt/Spur, 6*32*128=24576,  24576/Blockgroesse=6
    // Blockgroesse=2048, 2 Spuren, 72 Sekt/Spur, 2*72*128=18432,  18432/Blockgroesse=9

    IMG_File.Position:=DIR_Anfang;
    erster_Durchlauf:=true;

    for Zaehler_DRM:=0 to DPB.DRM do begin
      IMG_File.Read(DIR_Entry, 32);

      if (DIR_Entry.UserNumber<>$E5) then begin // E5H bedeutet der Eintrag ist nicht belegt
                                                // oder geloescht

        Inc(Anzahl_der_Eintraege);

        filename:=chr(DIR_Entry.filename[1] and $7F)+chr(DIR_Entry.filename[2] and $7F)+
                  chr(DIR_Entry.filename[3] and $7F)+chr(DIR_Entry.filename[4] and $7F)+
                  chr(DIR_Entry.filename[5] and $7F)+chr(DIR_Entry.filename[6] and $7F)+
                  chr(DIR_Entry.filename[7] and $7F)+chr(DIR_Entry.filename[8] and $7F);

        filetype:=chr(DIR_Entry.filetype[1] and $7F)+chr(DIR_Entry.filetype[2] and $7F)+
                  chr(DIR_Entry.filetype[3] and $7F);

        if erster_Durchlauf then begin
          DIR_Set := T_DIR_Set.Create;
          Grundeintrag;
          erster_Durchlauf:=false;
        end;


        if (DIR_Set.filename<>filename) or (DIR_Set.filetype<>filetype) then begin
          DIR_Entry_List.Add(DIR_Set);
          DIR_Set := T_DIR_Set.Create;
          Grundeintrag;
        end; { if (DIR_Set.filename<>filename) and (DIR_Set.filetype<>filetype) then }


        // logische_Erweiterung = (EXT & 1Fh) + ((S2 & 3Fh) << 5)
        logische_Erweiterung:=  (DIR_Entry.EX and $1F) + ((DIR_Entry.S2 and $3F) shl 5);
        // Rekordnr = logische_Erweiterung << 7 + (RC & 7Fh)
        //    DIR_Set.RecordCount := (logische_Erweiterung shl 7) + (DIR_Entry.RC and $7F);

        DIR_Set.RecordCount := (logische_Erweiterung shl 7) + DIR_Entry.RC;

        for Zaehler_AL:=1 to 8 do begin
          if DIR_Entry.AL[Zaehler_AL]>0 then begin
            BlockEntry := T_BlockEntry.Create;
            BlockEntry.BlockNumber:=DIR_Entry.AL[Zaehler_AL];
            DIR_Set.BlockList.Add(BlockEntry);
          end; { if DIR_Entry.AL[Zaehler_AL]>0 then }
        end; { for Zaehler_AL:=1 to 8 do }

      end; { if (DIR_Entry.UserNumber<>$E5) then }

    end; { for Zaehler:=0 to DPB.DRM do }

    if Anzahl_der_Eintraege>0 then
      DIR_Entry_List.Add(DIR_Set);


end; { procedure Twcpm.Dir_Entrys_To_DIR_Entry_List }








procedure Twcpm.DIR_Entry_List_To_CPM_DIR_List;
{
  Erzeugt aus der Struktur DIR_Entry_List die Stringlist CPM_DIR_List
}
  var
    DIR_Set : T_DIR_Set;
    BlockEntry : T_BlockEntry;
    Zaehler_DEL, Zaehler_BL : Integer;
    Zeile1, Zeile2, Zeile3 : String;

  begin
    CPM_DIR_List.Clear;

    if DIR_Entry_List.Count>0 then begin

      for Zaehler_DEL:=0 to DIR_Entry_List.Count-1 do begin
        DIR_Set:=T_DIR_Set(DIR_Entry_List[Zaehler_DEL]);

        Zeile1:='';
        for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do begin
          BlockEntry:=T_BlockEntry(DIR_Set.BlockList[Zaehler_BL]);
          Zeile1:=Zeile1+IntToHex(BlockEntry.BlockNumber,4)+'H ';
        end; { for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do }

        Zeile2:=Trim(DIR_Set.filename)+'.'+Trim(DIR_Set.filetype);

        while Length(Zeile2)<13 do
          Zeile2:=Zeile2+' ';

        Zeile3:=' S('+IntToStr(DIR_Set.RecordCount)+')';

        while Length(Zeile3)<8 do
          Zeile3:=Zeile3+' ';

        CPM_DIR_List.Add(Zeile2);

      end; { for Zaehler:=0 to DPB.DRM do }


    end; { if DIR_Entry_List.Count>0 then }


end; { procedure Twcpm.DIR_Entry_List_To_CPM_DIR_List }







procedure Twcpm.CPM_DIR_List_To_CPM_File;
var
  CopyName : String;
  CPM_File, Ziel_File : TMemoryStream;
  CPM_DIR_List_Count : Integer;


  procedure Read_File(FileName : String);
  var
    Zaehler_DEL, Zaehler_BL,
    Records_per_Block : Integer;
    F_Name, F_Type : String;
    First_Block_Pos, akt_Block_Pos,
    Read_Size, RecordCount : DWord;
    Buffer : Array [1..16384] of Byte;

    DIR_Set : T_DIR_Set;
    BlockEntry : T_BlockEntry;

  begin
    Format_CPM_File_Name(F_Name, F_Type, FileName);

    First_Block_Pos := DPB.SPT*DPB.OFF*128;
    // Blockgroesse=4096, 6 Spuren, 32 Sekt/Spur, 6*32*128=24576,  24576/Blockgroesse=6
    // Blockgroesse=2048, 2 Spuren, 72 Sekt/Spur, 2*72*128=18432,  18432/Blockgroesse=9

    IMG_File.Position:=First_Block_Pos;

    for Zaehler_DEL:=0 to DIR_Entry_List.Count-1 do begin
      DIR_Set:=T_DIR_Set(DIR_Entry_List[Zaehler_DEL]);

      if (DIR_Set.UserNumber=0) then begin
        if (DIR_Set.filename=F_Name) and (DIR_Set.filetype=F_Type) then begin

          RecordCount:=DIR_Set.RecordCount;
          Records_per_Block:=Blockgroesse div 128;

          for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do begin
            BlockEntry:=T_BlockEntry(DIR_Set.BlockList[Zaehler_BL]);
            akt_Block_Pos:=First_Block_Pos+(BlockEntry.BlockNumber*Blockgroesse);
            IMG_File.Position:=akt_Block_Pos;

            if RecordCount>=Records_per_Block then begin
              Read_Size:=Blockgroesse;
              RecordCount:=RecordCount-Records_per_Block;
            end
            else
              Read_Size:=RecordCount*128;

            IMG_File.Read(Buffer, Read_Size);
            CPM_File.Write(Buffer, Read_Size);

          end; { for Zaehler_BL:=0 to DIR_Set.BlockList.Count-1 do }

        end; { if (DIR_Entry.filename=F_Name) and (DIR_Entry.filetype=F_Type) then }
      end; { if DIR_Entry.UserNumber=0 then }

    end; { for Zaehler:=0 to DPB.DRM do }

  end; { procedure Read_File }


  function Dateien_sind_ungleich(var Datei_Nr1, Datei_Nr2 : TMemoryStream) : Boolean;
  var
    sind_ungleich : Boolean;
    Byte_Zaehler : LongInt;
    Byte_Nr1, Byte_Nr2 : Byte;
  begin

    sind_ungleich:=true;


    if Datei_Nr1.Size=Datei_Nr2.Size then begin

      sind_ungleich:=false;

      Datei_Nr1.Position:=0;
      Datei_Nr2.Position:=0;

      // byteweiser Vergleich der Dateien
      for Byte_Zaehler:=0 to Datei_Nr1.Size do begin

         Datei_Nr1.Read(Byte_Nr1, 1);
         Datei_Nr2.Read(Byte_Nr2, 1);

         if Byte_Nr1<>Byte_Nr2 then
           sind_ungleich:=true;

      end; { for Byte_Zaehler:=0 to Datei_Nr1.Size do }

    end; { if CPM_File2.Size=Ziel_File2.Size then }

    Result:=sind_ungleich;

  end; { function Dateien_sind_gleich }


begin
  { 256 VE * 32 Byte = 8192 Byte = 4 Bloecke }

  { 6800H = Block 4 }


  if CPM_DIR_List.Count>0 then begin
    CPM_File := TMemoryStream.Create;
    Ziel_File := TMemoryStream.Create;
    for CPM_DIR_List_Count:=0 to CPM_DIR_List.Count-1 do begin

      CPM_File.SetSize(0);
      CopyName:=CPM_DIR_List[CPM_DIR_List_Count];
      Read_File(CopyName);

      if FileExists(WIN_DIR_Pfad+Pfadtrenner+CopyName) then begin

        Ziel_File.LoadFromFile(WIN_DIR_Pfad+Pfadtrenner+CopyName);

        if Dateien_sind_ungleich(CPM_File,Ziel_File) then begin
          DeleteFile(PChar(WIN_DIR_Pfad+Pfadtrenner+CopyName));
          CPM_File.SaveToFile(WIN_DIR_Pfad+Pfadtrenner+CopyName);
        end;


      end {  }
      else begin
        CPM_File.SaveToFile(WIN_DIR_Pfad+Pfadtrenner+CopyName);
      end;

    end; { for ListBox_CPM_DIR_Count:=0 to ListBox_CPM_DIR.Count-1 do }

    CPM_File.Free;
    Ziel_File.Free;

  end; { if ListBox_CPM_DIR.Count>0 then }

end; { procedure Twcpm.CPM_DIR_List_To_CPM_File }








{ ***************************************************** }





destructor Twcpm.Destroy;
begin

  IMG_File.Free;
  inherited Destroy;
end; { destructor Twcpm.Destroy }




end.

