Program DSTIMGConv;
{$A+,B-,D-,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
Uses DOS;
const
  DSz = 1474560;
  TrSz = 512*18;
var
  Track0, Track1 : array[0..512*18-1] of Byte;
  FNMask, FN_Sr, FN_Dt : String;
  Dirst: DirStr;
  Namest: NameStr;
  Extst: ExtStr;
  fSrc, fDest : file;
  Srch : SearchRec;
  Srch1 : SearchRec;
  CountFiles : Word;
  NoConv : Word;
  Conv : Word;
  i : Word;
  IOR : Integer;
  iTr0s, iTr1s, iTr0d, iTr1d : LongInt;
{C:\PROGRA~2\BP70\TMP\denl.dst}
{C:\PROGRA~2\BP70\TMP\rtk.img}
Function UpString(Sra : String) : String;
var
 i : Byte;
 Sr : String;
begin
  Sr := Sra;
  for i := 1 to Length(Sr) do
    Sr[i] := UpCase(Sr[i]);
  UpString := Sr
end;
Procedure ConvToIMG;
begin
  FN_Dt := Copy(UpString(FN_Sr), 1, Pos('.DST', FN_Sr))+'IMG';
  FindFirst(Dirst+FN_Dt, AnyFile, Srch1);
  if Srch1.Name=FN_Dt then
  begin
    WriteLn('Файл ', FN_Dt, ' уже есть!');
    inc(NoConv);
    Exit;
  end;
  Write(FN_Sr, ' -> ', FN_Dt, '... ');
  Assign(fSrc, Dirst+FN_Sr);
  Assign(fDest, Dirst+FN_Dt);
  {$I-}
  Reset(fSrc, 1);
  {$I+}
  IOR := IOResult;
  if IOR<>0 then
  begin
    WriteLn('Ошибка чтения источника!(', IOR,')');
    inc(NoConv);
    Exit;
  end;
  if FileSize(fSrc)<>DSz then
  begin
    Close(fSrc);
    WriteLn('Ошибочная длина конвертируемого файла!');
    inc(NoConv);
    Exit;
  end;
  {$I-}
  ReWrite(fDest, 1);
  {$I+}
  IOR := IOResult;
  if IOR<>0 then
  begin
    Close(fSrc);
    WriteLn('Ошибка открытия файла-приёмника!(', IOR,')');
    inc(NoConv);
    Exit;
  end;

  iTr0s := 0;
  iTr1s := DSz div 2;
  iTr0d := 0;
  iTr1d := TrSz;

  for i := 0 to 79 do
  begin
   Seek(fSrc, iTr0s);
   BlockRead(fSrc, Track0, TrSz);
   Seek(fSrc, iTr1s);
   BlockRead(fSrc, Track1, TrSz);
   inc(iTr0s, TrSz);
   inc(iTr1s, TrSz);
   inc(iTr0d, TrSz);
   inc(iTr1d, TrSz);
   BlockWrite(fDest, Track0, 2*TrSz); {Пишем две дорожки}
  end;

  WriteLn('Сделано');
  Close(fSrc);
  Close(fDest);
  inc(Conv);
end;
Procedure ConvToDST;
begin
  FN_Dt := Copy(UpString(FN_Sr), 1, Pos('.IMG', FN_Sr))+'DST';
  FindFirst(Dirst+FN_Dt, AnyFile, Srch1);
  if Srch1.Name=FN_Dt then
  begin
    WriteLn('Файл ', FN_Dt, ' уже есть!');
    inc(NoConv);
    Exit;
  end;
  Write(FN_Sr, ' -> ', FN_Dt, '... ');
  Assign(fSrc, Dirst+FN_Sr);
  Assign(fDest, Dirst+FN_Dt);
  {$I-}
  Reset(fSrc, 1);
  {$I+}
  IOR := IOResult;
  if IOR<>0 then
  begin
    WriteLn('Ошибка чтения источника!(', IOR,')');
    inc(NoConv);
    Exit;
  end;
  if FileSize(fSrc)<>1474560 then
  begin
    Close(fSrc);
    WriteLn('Ошибочная длина конвертируемого файла!');
    inc(NoConv);
    Exit;
  end;
  {$I-}
  ReWrite(fDest, 1);
  {$I+}
  IOR := IOResult;
  if IOR<>0 then
  begin
    Close(fSrc);
    WriteLn('Ошибка открытия файла-приёмника!(', IOR,')');
    inc(NoConv);
    Exit;
  end;

  iTr0s := 0;
  iTr1s := TrSz;
  iTr0d := 0;
  iTr1d := DSz div 2;

  for i := 0 to 79 do
  begin
   Seek(fSrc, iTr0s);
   BlockRead(fSrc, Track0, TrSz);
   inc(iTr0s, 2*TrSz);
   BlockWrite(fDest, Track0, TrSz);
  end;

  for i := 0 to 79 do
  begin
   Seek(fSrc, iTr1s);
   BlockRead(fSrc, Track1, TrSz);
   inc(iTr1s, 2*TrSz);
   BlockWrite(fDest, Track1, TrSz);
  end;

  WriteLn('Сделано');
  Close(fSrc);
  Close(fDest);
  inc(Conv);
end;
Procedure ConvertFiles;
begin
  CountFiles := 0;
  NoConv := 0;
  Conv := 0;
  FNMask := ParamStr(1);
  FSplit(FNMask, Dirst, Namest, Extst);
  FindFirst(FNMask, $27, Srch);
  While DOSError = 0 do
  begin
    FN_Sr := Srch.Name;
    FSplit(Dirst+FN_Sr, Dirst, Namest, Extst);
    if UpString(Extst)='.DST' then ConvToIMG else
      if UpString(Extst)='.IMG' then ConvToDST else
        begin
          WriteLn('Конвертируемый файл должен иметь расширения .dst или .img! : ', FN_Sr);
          inc(NoConv);
        end;
    FindNext(Srch);
    inc(CountFiles);
  end;
  WriteLn;
  WriteLn('-----===== Итог =====-----');
  WriteLn('Всего файлов: ', CountFiles);
  WriteLn('Пропущено: ', NoConv);
  WriteLn('Отконвертировано: ', Conv);
end;
begin
  WriteLn('_____________________________________________________');
  WriteLn('DST/IMG Convertor. V1.0. 18-19.10.2003');
  WriteLn('Программа конвертирует форматы файлов образов дискет.');
  WriteLn('DST <-> IMG (IMG - более быстрый в использовании)');
  WriteLn(#9#9#9#9#9#9'Shyar');
  if ParamCount<>0 then ConvertFiles else
    WriteLn('Укажите в коммандной строке имя конвертируемого файла (с расширением .dst/.img)');
end.

Назад