Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ARCUNIT.ZIP/ARCHIVE.PAS

Pascal/Delphi Source File | 1989-11-05 | 5.4 KB | 175 lines

{$I-,V-,S-,R-,D-}
     {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
     {                         Glowing Spark Software                     }
     {                            Name: Archive                           }
     { Author: Moshe Boochbut                                Version: 1.0 }
     { Last update: 12-Sep-1988                                           }
     {____________________________________________________________________}
Unit Archive;

INTERFACE

Const
  StoreMathod = 1;                   {The store mathod code         }
  ArchiveMark = $1A;                 {The Archive mark (^Z)         }

Type
  Asciiz     = Array [1..13] Of Byte;
  ArcInfo    = Record
                 ArcMark      : Byte;       {The Arc Mark, always 1A (Hex)      }
                 CompressType : Byte;       {Compressing mathod code (0=Stored) }
                 FileName     : Asciiz;     {The file name in the arc (asciiz)  }
                 CompressSize : LongInt;    {The space file occupy (in Bytes)   }
                 FileDate,                  {DOS Coded date                     }
                 FileTime,                  {    and time                       }
                 CRCword      : Word;       {CRC check word                     }
                 RealSize,                  {The real file size after unarcing  }
                 FoundAt,                   {The file position in archive       }
                 NextFileAt   : LongInt;    {The position of next file          }
                 FileNameStr  : String[12]; {The file name in String format     }
                 FullName     : String[70]; {Archive name (by ArcFindFirst)     }
               end; {Record}

var
  ArcOK          : Boolean;


IMPLEMENTATION

function LenAsc(A : Asciiz) : Word;
  InLine
   ($5F/                     {pop  di       ;get pointer to ASCIIZ}
    $07/                     {pop  es       ; into es:di}
    $89/$FB/                 {mov  bx,di    ;store initial offset}
    $B9/$FF/$FF/             {mov  cx,$FFFF ;check maximum length}
    $B0/$00/                 {mov  al,0     ;look for null}
    $FC/                     {cld           ;forward direction}
    $F2/                     {repne}
    $AE/                     {scasb         ;scan while equal}
    $29/$DF/                 {sub  di,bx    ;get the number of bytes scanned}
    $89/$F8/                 {mov  ax,di    ;return in ax}
    $48);                    {dec  ax       ;null doesn't count}

function PadCh (S : String; Ch : Char; n : Byte): String;
var
  St   : String;
  i    : Byte;
begin
  St := S;
  for i := Length (S) to n do
    St := St + Ch;
  PadCh := St;
end; {PadCh}

function Asc2Str(var A : Asciiz) : string;
var
   S : string;
   Len : byte;
begin
   Len := lo(LenAsc(A));
   S[0] := Char(Len);
   Move(A, S[1], Len);
   Asc2Str := S;
end; {Asc2Str}



procedure ListArc;
var
  ArcFile       : File;
  NumRead       : Integer;
begin
  Assign (ArcFile, ArchiveInfo.FullName);
  Reset (ArcFile, 1);
  FoundAt := 0;
  NextFileAt := 0;
  while not eof(ArcFile) do
  begin
    Seek (ArcFile, ArchiveInfo.NextFileAt);
    BlockRead (ArcFile, ArchiveInfo, 25, NumRead);
    if (ArchiveInfo.ArcMark = ArchiveMark) and (NumRead = 25) Then
    with ArchiveInfo do
    begin
      FoundAt := FilePos (ArcFile) - 25;
      FileNameStr := Asc2Str (ArchiveInfo.FileName);
      if CompressType = StoreMathod Then
        RealSize := CompressSize
      else
      begin
        BlockRead (ArcFile, RealSize, 4, NumRead);
        Inc (NextFileAt, 4);
      end;
      Inc (NextFileAt, CompressSize + 25);
    end; {with}
      Close (ArcFile);
    end; {if IOResult}
  end; {if IOResult}
end; {ArcGetNext}


procedure ArcGetFirst (ArchiveName :String; var ArchiveInfo : ArcInfo);
begin
  with ArchiveInfo do
  begin
  end; {with}
  ArcGetNext (ArchiveInfo);
end; {ArcGetFirst}


procedure ArcCopy (SrcArc : ArcInfo; DstFileName : String);
Const
  EndOfArc : Word = $001A;

var
  ArcFile,
  DstFile       : File;
  NumWritten,
  NumRead,
  NumToRead     : Word;
  LeftToCopy    : LongInt;
  CopyBuffer    : Array [0..4096] Of Byte;

begin
  ArcOK := False;
  Assign (ArcFile, SrcArc.FullName);
  Reset (ArcFile, 1);
  if IOResult = 0 Then
  begin
    Assign (DstFile, DstFileName);
    Reset (DstFile, 1);
    if IoResult <> 0 Then
      Rewrite (DstFile, 1)
    Else
      Seek (DstFile, FileSize (DstFile) - 2);
    if IOResult = 0 Then
    begin
      Seek (Arcfile, SrcArc.FoundAt);
      if IOResult = 0 Then
      begin
        LeftToCopy := SrcArc.NextFileAt - SrcArc.FoundAt;
        Repeat
          if LeftToCopy > SizeOf (CopyBuffer) Then
            NumToRead := SizeOf (CopyBuffer)
          Else
            NumToRead := LeftToCopy;
          Dec (LeftToCopy, NumToRead);
          BlockRead (ArcFile, CopyBuffer, NumToRead, NumRead);
          BlockWrite (DstFile, CopyBuffer, NumRead, NumWritten);
        Until (NumToRead <> NumWritten) Or (LeftToCopy = 0);
        if LeftToCopy = 0 Then
        begin
          BlockWrite (DstFile, EndOfArc, 2, NumWritten);
          if NumWritten = 2 Then
            ArcOK := True;
        end; {if LeftToCopy}
        Close (ArcFile);
        Close (DstFile);
      end; {if IoResult}
    end; {if IoResult}
  end; {if IoResult}
end; {ArcCopy}

begin
  ArcOk := True;
end.