Programmer 7500/MAX_PROGRAMMERS.iso/INFO/FILUTL/TOADSHR1.ARC/TOADSHR1.PAS

Pascal/Delphi Source File | 1989-06-14 | 34.8 KB | 1,012 lines

PROGRAM ToadShar;

{ Toad Hall Shar v1.1 for Turbo Pascal v5.0

  Other shars available for MS-DOS had no wildcard capability,
  and I got BLOODY tired of typing in all those filenames!

  This one's got wildcard capability (both for shar creation and extraction).

  I've arbitrarily decided to force the world to accept the MS-DOS shar
  file type of ".SHR" for a shar file type (when wildcard extracting)
  (since we can't use the Unix ".shar" standard).

  You don't like it?  Recode it!

  No, I don't know how to change it for Turbo Pascal v4.0.

  Usage:
    shar [-u] [file1]..[filen]

    Where file1..filen can be up to 20 MS-DOS path\filenames
    (wildcarded if you wish).  (The 20 was arbitrary .. see MAXARGS.)

    -u     Unshar (extract) members from shar file(s).
           Yes, the -u (any case) MUST be the first command line parameter!
           shar filenames can be full DOS paths, with a default file
           type of ".SHR" (added if required).

  During shar creation:
    The .SHR files produced will be simplistic (e.g., none of the fancy
    Unix switches are available).  However, they should be compatible
    with Unix shars (provided you work around the line ending problem,
    of course).

    Shar-formatted output is to StdOut (e.g., via redirection at the
    DOS command line).  No check is made for an output file's existence
    (naturally).  Output is standard DOS text file (e.g., CR/LF line
    endings).

    No tests are made to filter out control characters, etc., and target
    member files are treated as text files.  I would NOT suggest using
    this shar on anything but pure Ascii text files!

    Any error msgs will go to StdOut (yep, the file you're creating!).
    Sorry 'bout that .. don't wanna mess with a StdErr output routine
    at this time.  Maybe later.


  During extraction:

    You can wildcard the extracting.  (E.g., if you have FOO1.SHR and
    FOO2.SHR, just enter "TOADSHAR FOO*" and both files will be unshared.)

    Existing files will NOT be overwritten!  You'll get a warning message,
    and shar will continue to work its way through the remaining shar file
    members (if any).

    No tests are made (to date) to replicate sed or sh errorchecking
    (e.g., the simplistic character count).

    Some sed/sh "echo" commands are echoed to StdOut during extraction.

  I've tested TOADSHAR on Unix and MS-DOS .shar files created with various
  switch settings .. seems to work ok.

  This sucker isn't ALL it could be yet .. could use more file read/write
  error trapping, more sophisticated sh-like testing (char counts,
  file overwriting, etc.) .. but it'll do for now.

  Credits:
    Fancy dynamic arrays of FindFirst and FindNext SearchRecs,
    thanks to a hack of:

    "Linked list modules from LINKLIST.PAS"
    Copyright (c) 1985 by Alan D. Hull

    Boyer-Moore string searching (credits, source in POSBM.ASM)

    Released to the public domain.
    Constraints:  Do NOT distribute without source and documentation.
                  Do NOT remove credits.

    David P Kirschbaum
    Toad Hall
    [e-mail]
    (or maybe [e-mail])
    [phone] voice/data

    v1.0  Original release
    v1.1  Added:
            new posBM and posCH POS() replacements.
            StdErr message output.
}

{$B-}  {shortcut Boolean logic}
{$D-}  {No debug info}
{$F-}  {No far calls}
{$L-}  {No local symbol info}
{$R-}  {No range checking}
{$S-}  {No stack checking .. taking a chance on this one
        for systems with VERY limited memory ..
        You don't like it?  Recompile it.}
{$V-}  {Relaxed VAR string parm testing}

{ DEFINE Debug}  {enable for some debug displays, file overwriting, etc.}

Uses Dos;  {for the Find First/Find Next stuff}

TYPE
  Str20 = STRING[20];
  Str80 = STRING[80];

CONST
  QUOTE = #39;                      {single-quotation mark/apostrophe char}
  MAXARGS = 20;                     {change as you like}
  VERSION = 'v1.1';
  CRLF : ARRAY[1..2] OF CHAR = #$0D#$0A;  {v1.1}

VAR
  argv, argc : Byte;
  Args : ARRAY[1..MAXARGS]          {array of cmdline parms}
           OF PathStr;              {STRING[79]}

  InFile : TEXT;


{

SearchRec, DirStr, NameStr, ExtStr are declared in the Dos unit.
 As a reminder:

 TYPE SearchRec = RECORD
                    fill : ARRAY[1..21] OF Byte;
                    attr : Byte;
                    time : longint;
                    size : longint;
                    Name : STRING[12];
                  END;
}
    SrchRec : SearchRec;

    Dir : DirStr;                     {STRING[79]}
    Name: NameStr;                    {STRING[8]}
    Ext : ExtStr;                     {STRING[4]}

CONST

  {The shar file header (picked from a handy Unix speciman).
  This array of array of chars is a kludge, I know .. but it was the
  simplest/fastest way to collect one big hunk of characters for output.
  Now if I wanted to add my block read/writes .. but then we wouldn't
  have a nice neat TEXT file, would we?
  }
(*
  Hdr1 : ARRAY[1..26] OF CHAR = '#    This is a shell archive.';
  Hdr2 : ARRAY[1..53] OF CHAR =
'#    Remove everything above and including the cut line.';
  Hdr3 : ARRAY[1..43] OF CHAR =
'#    Then run the rest of the file through sh.';
  Hdr4 : ARRAY[1..57] OF CHAR =
'#----cut here-----cut here-----cut here-----cut here----#';
  Hdr5 : ARRAY[1..9] OF CHAR = '#!/bin/sh';
  Hdr6 : ARRAY[1..25] OF CHAR = '# shar:    Shell Archiver';
  Hdr7 : ARRAY[1..48] OF CHAR =
'#    Run the following text with /bin/sh to create:';
*)

  NR_HDRLINES = 4;
  Hdr : ARRAY[1..NR_HDRLINES] OF Str80 =
  (
'#  This is a shell archive.'#$0D#$0A'# Remove everything above and including the cut ',
'line.'#$0D#$0A'# Then run the rest of the file through sh.'#$0D#$0A'#----cut here-----cut here',
'-----cut here-----cut here----#'#$0D#$0A'#!/bin/sh'#$0D#$0A'# shar:    Shell Archiver',
#$0D#$0A'# Run the following text with /bin/sh to create:'#$0D#$0A
  );


{Load our posBM and posCH modules}

{$F+}
{$L POSBM}

FUNCTION posBM(Pat,Str : STRING) : BYTE; EXTERNAL;

{$L POSCH}
FUNCTION posCH(Ch : CHAR; S : STRING) : BYTE; EXTERNAL;

{And our StdErr procedure}
{$L STDERR}

PROCEDURE Write_StdErr(S : STRING); EXTERNAL;
{$F-}

{
(Linked list modules from LINKLIST.PAS)
 Copyright (c) 1985 by Alan D. Hull
 TURBO LinkList modules and descriptions are hereby donated to
 the public domain. They may be included  in  any  other  free
 software  without  royalties  to  the  author. TURBO LinkList
 procedures,  descriptions  and/or  declarations  may  not  be
 included  in  whole  or  in part in any program, function, or
 package   sold  for  commercial  gain,  without  the  express
 permission of the author.

 Thanks, Alan .. gee, 1985 .. sigh ..
}


TYPE
{ We don't really NEED the entire SearchRec saved (from a FindFirst
  or FindNext) .. but I'm keeping it handy for now.
  Actually, all we need is the Dir and SearchRec.Name (for opening
  input files later).
}
  SrchRecPtr = ^node;

  node = RECORD                         { this is the linked list node }
    flink,
    blink   : SrchRecPtr;
    SrchRec : SearchRec;                { map in a data record }
    Dir     : DirStr;                   {remember the directory also}
  END;

VAR
  head, tail, curr, Temp  :   SrchRecPtr;



PROCEDURE Allocate_Node( VAR node_ptr: SrchRecPtr);
  {  Allocate a node of a doubly-linked list  }
  BEGIN
    NEW (node_ptr);                     { get a new block of memory }
    node_ptr^.flink := NIL;             { make sure it doesn't point to }
    node_ptr^.blink := NIL;             { any other nodes yet. }
  END;


PROCEDURE Add_After_Node (VAR head, tail, current, newp: SrchRecPtr);
  {  Add the node to the linked list
     head    - A pointer to the first node in the linked list
     tail    - A pointer to the last node in the linked list
     current - A pointer to the node in the list that the new node
               is to be added after.
     newp    - A pointer to the node to be added to the linked list.
               (Couldn't use NEW since it's a reserved word in Pascal)
  }
  VAR  next: SrchRecPtr;
{  1.  The list is empty, head, tail, and current will point to newp.
   2.  We are adding past the end of the list.  Redirect tail.
   3.  Adding at some point other that after the tail.
   4.  Point current to the new node.
}

  BEGIN
    IF (current = NIL) THEN BEGIN    { 1 }
      head := newp;
      tail := newp;
    END
    ELSE BEGIN
      IF (current = tail) THEN BEGIN    { 2 }
        current^.flink := newp;
        newp^.blink := current;
        newp^.flink := NIL;
        tail := newp;
      END
      ELSE BEGIN    { 3 }
        next := current^.flink;
        newp^.flink := next;
        newp^.blink := current;
        next^.blink := newp;
        current^.flink := newp;
      END
    END;
    current := newp;    { 4 }
  END;  {Add_After_Node}


(*
{To remove a node:   looks like this.  We don't DO this .. just left
 Alan's comments/code for your edification.

 1. before removing the current node from list, we need to store the
    pointer to the previous node, so that we can step "back" a node to
    continue processing thru the list.
 2. Restore the pointer from item 1 as the current node
}
    curr := head;
    IF curr <> NIL THEN BEGIN
      temp := curr^.blink;         { save pointer to prev. node }
      Remove_Node (head, tail, curr);
      curr := temp;                { reassign to maintain continuity }
      curr := curr^.flink;
{or}  curr := temp^.flink;
    END;
*)

{ ***** End of LINKLIST-related stuff ***** }

FUNCTION ItoS(i : INTEGER) : Str20;
  VAR  S : Str20;
  BEGIN
    STR(i,S);
    ItoS := S;
  END;  {of ItoS}


PROCEDURE Usage;
  BEGIN
    Writeln('TOADSHAR public domain shar/unshar utility ', VERSION);
    Writeln;
    Writeln('Usage:  shar [-u] [file1]..[filen] [>output.shr]');
    Writeln;
    Writeln('Where file1..filen can be up to 20 MS-DOS path\filenames');
    Writeln('(wildcards permitted).');
    Writeln('Output is to StdOut (e.g., redirectable).');
    Writeln;
    Writeln('-u     Unshar (extract) members from shar file(s).');
    Writeln('       Yes, the -u MUST be the first command line parameter!');
    Writeln('       shar filenames can be full DOS paths,');
    Writeln('       with a default file type of ".SHR" (added if required).');
    Writeln('       Extracted file will NOT be written if a file of that name');
    Writeln('       exists on the current drive:\directory.');
    Writeln;
    Writeln('Courtesy of David Kirschbaum, Toad Hall');
    Halt(1);
  END;  {of Usage}


FUNCTION Uc (S : String) : String;
  {v1.3 Returns S uppercased}
  BEGIN
Inline(
  $31/$C0/       {  xor   ax,ax}
  $8A/$86/>S/    {  mov   al,>S[bp]  ;snarf the length}
  $09/$C0/       {  or    ax,ax      ;0 length?}
  $74/$18/       {  jz    Exit       ;yep, exit}

  $89/$C1/       {  mov   cx,ax      ;loop counter}
  $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  $31/$F6/       {  xor   si,si}
                 {L1:}
  $46/           {  inc   si       ;next char}
  $36/           {  SS:}
  $8A/$82/>S/    {  mov   al,>S[bp][si]  ;snarf the char}
  $38/$D0/       {  cmp   al,dl}
  $72/$05/       {  jb    S1       ;already uppercase}
  $36/           {  SS:}
  $28/$B2/>S/    {  sub  >S[bp][si],dh   ;uppercase it}
                 {S1:}
  $E2/$EF);      {  loop  L1}
                 {Exit:}

    Uc := S;    {return the function}
  END;  {of Uc}


PROCEDURE Strip(Ch : CHAR; VAR S : String);
  {Strip any Ch chars from S}
  VAR  p : INTEGER;
  BEGIN
    Repeat
      p := posCh(Ch,S);             {v1.1 any there?}
      IF p <> 0 THEN Delete(S,p,1); {yep, gobble them}
    Until p = 0;
  END;  {of Strip}


FUNCTION Bracketed(S : String) : String;
  {return string in brackets}
  BEGIN
    Bracketed := '[' + S + ']';
  END;  {of Bracketed}


PROCEDURE Get_Args;
  {v1.3 process command line for all target filenames.
        Move them into an array of PathStrs.
  }
  BEGIN
    argc := ParamCount;
    IF (argc = 0)                       {no parms at all}
    OR (argc > MAXARGS)                 {or more than we can handle}
    THEN Usage;                         {display help, die}

    FOR argv := 1 TO argc DO
      Args[argv] := Uc(ParamStr(argv));   {snarf parm, (uppercased)}
    Args[SUCC(argc)] := '';               {double-insure no overruns}

  END;  {of Get_Args}


PROCEDURE Find_All;
  {Work FindFirst/FindNext for each Arg name.
   When FindFirst or FindNext fails, start on the next argv.

   Remember, StdOut may be creating a file that meets the argument.
   However .. since that StdOut file will (should?) be 0 size
   (until DOS closes it) .. we can trap that easily enough.
   Side-effect is:  we won't be able to include any 0-sized files ..
   but who wants to do that anyway?
  }
    VAR  Ok  : BOOLEAN;

    PROCEDURE Make_Node;
      BEGIN
        IF SrchRec.size <> 0 THEN BEGIN {only for non-empty files.
                                         This also stops us from
                                         picking up the StdOut file!}
          Allocate_Node(temp);
          Temp^.Dir := Dir;
          Temp^.SrchRec := SrchRec;     {move in the whole search record}
          Add_After_Node (head,tail,curr,Temp);
        END;
      END;  {of Make_Node}

  BEGIN  {Find_All}
    head := NIL;               {init our filename pointer linked list}
    tail := NIL;
    curr := NIL;
    temp := NIL;

    FOR argv := 1 TO argc DO BEGIN          {do all the args}

      FSplit(Args[argv], Dir, Name, Ext);   {split up the new name}
      Findfirst(Args[argv],                 {full name}
                READONLY OR ARCHIVE,
                SrchRec);

      IF DosError = 0 THEN BEGIN            {FindFirst succeeded}
        Make_Node;                          {save the FindFirst name}
        Repeat
          FindNext(SrchRec);                {find any more}
          Ok := (DosError = 0);
          IF Ok THEN Make_Node;             {save the FindNext name}
        UNTIL NOT Ok;                       {until FindNext failed}
      END;  {if FindFirst succeeded}
    END;  {argv loop}
  END;  {of Find_All}


FUNCTION Exists (FName : PathStr) : BOOLEAN;
  {Return TRUE if FName exists}
  VAR F : FILE;
  BEGIN
    Assign(F,FName);
    {$I-}  Reset(F);  {$I+}
    IF IoResult = 0 THEN BEGIN          {exists}
      Exists := TRUE;                   {return function TRUE}
      Close(F);                         {be neat}
    END
    ELSE Exists := FALSE;               {return function FALSE}
  END;  {of Exists}


PROCEDURE Show_TargetNames;
  VAR S : Str80;
  BEGIN
    Write_StdErr('shar: target files: ');     {v1.1 A little informative..}
    curr := head;                       {..wildcard info}
    S := '';                            {v1.1 clear output string}
    WHILE curr <> NIL DO BEGIN
      S := S + curr^.SrchRec.Name;      {build a string of names}
      curr := curr^.flink;              {bump to next name}

      IF LENGTH(S) > 60 THEN BEGIN      {string's long enough...}
        Write_StdErr(S + CRLF);         {...so display the names}
        S := '';                        {...and clear the string}
      END
      ELSE IF curr <> NIL               {isn't last name...}
      THEN S := S + ', ';               {..so separate names neatly}
    END;

    IF S <> '' THEN Write_StdErr(S + CRLF);  {v1.1 display last partial string}
  END;  {of Show_TargetNames}


PROCEDURE UnShar;
  {-u parm on cmdline.  We may have filename(s)
   or wildcards starting at Args[2].
   Shift all args down one, expand wildcards, etc.
   If no file type, use '.shr'.
   If no Args[2], use '*.shr'
  }
  VAR
    S : String;
    OutFile : TEXT;
    p,
    line : word;
    slen : BYTE Absolute S;
    SharEof : BOOLEAN;
    Ch : CHAR;


  FUNCTION Word(S : String; p : INTEGER; Delim : CHAR) : Str20;
    {Returns the next word starting at S[p],
     and ending at the char Delim (or String end)
    }
    VAR Ch : CHAR;
    BEGIN
      Delete(S,1,PRED(p));              {gobble leading chars}
      IF S = '' THEN BEGIN
        Word := S;                      {Return function}
        Exit;
      END;

      WHILE (LENGTH(S) > 0)             {while we have a string}
      AND (S[1] <= #$20) DO             {and leading char is ctrl}
        Delete(S,1,1);                  {gobble it (really after spaces
                                         and tabs)}

      p := posCH(Delim,S);              {v1.1 find delimiter}
      IF p = 0 THEN Word := S           {no delimiter,
                                         return remaining string}
      ELSE Word := Copy(S,1,PRED(p));   {return up to but not including
                                         delimiter}
    END;  {of Word}


  PROCEDURE Die(Msg : String);
    BEGIN
      Write_StdErr('shar: ' + Msg
                   + ' Line: ' + ItoS(line) + CRLF);  {v1.1}
      {$I-}  Close(OutFile); {$I+}      {in case not opened}
      IF IoResult <> 0 THEN;            {we don't care}
      SharEof := TRUE;                  {post boolean}
    END;  {of Die}


  PROCEDURE  ReadLn_Eof;
    {Halts us if we hit input file EOF}
    BEGIN
      S := '';                          {insure S is cleared}
      IF NOT SharEof THEN SharEof := Eof(InFile);
      IF NOT SharEof THEN BEGIN
        ReadLn(InFile,S);
        Inc(line);
      END;
    END;


  PROCEDURE Extract_Member;
    {Extracts a single member (down to SHAR_EOF or whatever
     We should be at a line that looks like this:
          cat << \SHAR_EOF > test1.doc
     or maybe 2 lines (if some switches like -s or -a were used):
          echo shar: extracting test1.doc
          sed 's/^XX//' << \SHAR_EOF > test1.doc
     or   sed 's/^X//' > unshar.c << '/'
     or   sed 's/^X//' > makeguide << 'EOF'

     It's not LIKELY SHAR_EOF would change between members,
     but we'll check every time anyway.
    }
    VAR
      OutName : PathStr;
      EofStr : STRING[20];                 {for SHAR_EOF or whatever}
      LeadChars : STRING[5];               {guessing as to min length}
      leadlen  : BYTE absolute LeadChars;  {nr of leadchars}
      DoOutPut,
      Ok : BOOLEAN;


    PROCEDURE Check_LeadChars;
      {Extract_Member subroutine
       In case some more switches were engaged,
       and we get a line like this:
           sed 's/^XX//' << \SHAR_EOF > test1.doc
       or  sed 's/^X//' > unshar.c << '/'
       or  sed 's/^X//' > makeguide << 'EOF'
      }
      VAR p1,p2 : INTEGER;
      BEGIN
        LeadChars := '';                      {assume no leading chars}
        IF Word(S,1,' ') <> 'sed' THEN Exit;  {only sed does leading chars}

        p1 := posBM('s/^',S);                 {v1.1}
        IF p1 = 0 THEN Exit;                  {no leading chars}

        Inc(p1,3);                            {bump past 's/^'}
        p2 := posBM('//',S);                  {v1.1 find end of token}
        IF p2 > p1                            {gotta have at least 1}
        THEN LeadChars := Copy (S,p1,p2-p1);  {copy leading chars}

        IF LeadChars = ''                     {last test}
        THEN Die('s/ Leading char error');    {bad format, SharEof TRUE}

      END;  {of Check_LeadChars}


    PROCEDURE Get_SharEof;
      {Extract_Members subroutine.
       Find the "\SHAR_EOF > ", save it.
       Again, we're working a command line like:
              cat << \SHAR_EOF > test1.doc
       or     sed 's/^XX//' << \SHAR_EOF > test1.doc
       or     sed 's/^X//' > unshar.c << '/'
       or     sed 's/^X//' > makeguide <<'EOF'
      }
      BEGIN
        EofStr := '';                         {clear it}
        p := posBM('<<', S);                  {v1.1 find the SHAR_EOF token}
        IF p <> 0 THEN BEGIN                  {ok, found it}
          Inc(p,2);                           {skip past '<<'}
          EofStr := Word(S,p,' ');            {get next word}
          IF EofStr <> '' THEN BEGIN          {we got something!}
            Case EofStr[1] OF
              QUOTE : Ch := QUOTE;            {extract between quotes}
              '\'   : Ch := ' ';              {extract up to space}
              ELSE  Ch := #0;                 {an error}
            END;  {case}
            IF Ch = #0 THEN EofStr := ''
            ELSE EofStr := Word(EofStr,2,Ch);  {extract word up to delimiter}
          END;
        END;  {if SHAR_EOF Token}

        IF EofStr = '' THEN Die('No SHAR_EOF'); {SharEof TRUE}

      END;  {of Get_SharEof}


    PROCEDURE Get_OutName;
      {Extracts output filename from cat or sed cmdline.
       Again, we're working a command line like:
              cat << \SHAR_EOF > test1.doc
       or     sed 's/^XX//' << \SHAR_EOF > test1.doc
       or     sed 's/^X//' > unshar.c << '/'
       or     sed 's/^X//' > makeguide << 'EOF'
       Note:  The name could be quoted!
       v1.1 Warning msg output is to StdOut, but that's ok ..
       User shouldn't be redirecting on UnSharing.
      }
      VAR
        OutN1 : PathStr;
        S1 : Str80;
      BEGIN
        OutName := '';                      {clear it}
        p := posCH('>', S);                 {v1.1 find the filename output char}
        IF p < 3 Then BEGIN                 {should be deep in the cmdline}
          Die('Format Error');              {SharEof TRUE}
          Exit;
        END;

        OutName := Word(S,SUCC(p),' ');     {Extract output filename}
        Strip(QUOTE,OutName);               {gobble any quotation marks}
        Strip('"',OutName);                 {these too}

        IF OutName <> '' THEN BEGIN         {some rudimentary parsing}

          OutName := Uc(OutName);           {uppercase it now}

          OutN1 := OutName;                 {fiddle local name}
          IF OutN1[1] = '.' THEN BEGIN      {Leading periods is bogus}
            Write_StdErr('shar:  WARNING!  Replacing period in filename: '
                         + Bracketed(OutN1) + CRLF);  {v1.1}
            OutN1[1] := '_';                {replace with something else}
          END;
          FSplit(OutN1, Dir, Name, Ext);    {split up the new name}
          IF Dir <> '' THEN BEGIN           {better be empty!}
            Write_StdErr('shar:  WARNING!  Ignoring Output name path: '
                         + Bracketed(Dir) + CRLF);  {v1.1}
          END;
          OutN1 := Name + Ext;              {build new name after the split}
          IF OutN1 <> OutName THEN BEGIN
            Write_StdErr('shar:  WARNING!  Output name amended from '
                    + Bracketed(OutName) + ' to ' + Bracketed(OutN1)
                    + CRLF );               {v1.1}
            OutName := OutN1;
          END;
        END;                                {hopefully it'll be legal}

        IF OutName = ''                     {couldn't parse output filename}
        THEN Die('Missing filename');       {SharEof TRUE}

      END;  {of Get_OutName}


    PROCEDURE Process_Member;
      {Extract_Member subroutine.
       We're now reading the shar file's data.
       Strip lead chars if necessary.
       Stop at SHAR_EOF (in EofStr).
      }
      BEGIN

        ReadLn_Eof;                            {start the read/write}
        WHILE (NOT SharEof)                    {not physical EOF}
          AND (S <> EofStr)                    {and not member SHAR_EOF}
        DO BEGIN
          IF leadlen <> 0 THEN BEGIN           {we have leading chars}
            IF COPY(S,1,leadlen) <> LeadChars  {a fatal error}
            THEN BEGIN
              Die('Missing LeadChars: ' + Bracketed(S));
              Exit;                            {quit now}
            END;

            Delete(S,1,leadlen);           {gobble leading chars}
          END;

          IF DoOutPut                      {we're writing an output file}
          THEN Writeln(OutFile,S);         {write out the string}
          ReadLn_Eof;                      {new S}
        END;  {wend}
                                           {S = 'SHAR_EOF' or physical EOF}
      END;  {of Process_Member}


    BEGIN  {Extract_Member (UnShar subroutine)}

      {We're now processing the first command lines for this member.}

      Check_LeadChars;                  {check for just 'cat ' cmd or
                                         maybe the more complicated
                                         "sed 's/^XX//'" (lead chars).
                                         Process accordingly.}
      Get_SharEof;                      {Extract "\SHAR_EOF > " from cmdline
                                         as EofStr.}

      Get_OutName;                      {Extract '> filename' from cmdline
                                         as OutName.}
      IF SharEof THEN Exit;             {failed during cmdline processing}

      DoOutput := TRUE;                 {Assume we will output}
      Write_StdErr('  Member: ' + OutName + CRLF);  {v1.1 display member file}

{$IFNDEF Debug}
      IF Exists(OutName)                {no overwriting!}
      THEN BEGIN
        Die('File Exists: ' + Bracketed(OutName));
        SharEof := FALSE;               {but keep working the .shr file}
        DoOutput := FALSE;              {process, but no output}
      END;
{$ENDIF}

      IF DoOutPut THEN BEGIN            {we're outputting a member}
        Assign(OutFile,OutName);        {so gotta create its file}
        {$I-} ReWrite(OutFile);  {$I+}
        IF IoResult <> 0                {create failed somehow}
        THEN BEGIN
          Die('Create error: ' + Bracketed(OutName));
          SharEof := FALSE;             {but keep working the .shr file}
          DoOutput := FALSE;            {but no attempts to output}
        END;
      END;

      Process_Member;                   {process the file down to SHAR_EOF}

      {Done with this member.  Current S should be SHAR_EOF}

      IF DoOutPut THEN BEGIN
        {$I-}  Close(OutFile);  {$I+}   {just in case of a problem}
        IF IoResult <> 0 THEN;          {we don't care}
      END;
    END;  {of Extract_Member}


  PROCEDURE Sh;
    {Crudely do what Sh does ..
      " and blindly go where no man has dared before .. "
     (for 'blindly', read 'ignorantly')
    }
    CONST
      Sh_Words : STRING[46] =
        'if then else fi test echo export cat sed exit ';
        {Why this overwhelming urge to include "fee fi fo fum"?}
    VAR
      W : Str20;
      IfFlag,                 {Not fully implemented yet..}
      ThenFlag,               {..but I didn't wanna write..}
      ElseFlag : BOOLEAN;     {..a full sh parser!}

    BEGIN
      IfFlag := FALSE;
      ThenFlag := FALSE;
      ElseFlag := FALSE;

      WHILE NOT SharEof DO BEGIN

        S[1] := #0;                     {physically clear first char}
        S := '';                        {clear the string}

        While  (                        {a la c ...}
               (S = '')                 {gobble blank lines}
            OR (S[1] IN ['#',':'])      {and sh comments}
               )
           AND NOT SharEof              {but not physical EOF}
        DO ReadLn_Eof;                  {work through header, junk}

        IF SharEof THEN Exit;           {physical EOF, done}

        W := Word(S,1,' ') + ' ';       {S's first word, plus a space}


{a reminder:
  Sh_Words : STRING[46] =
    'if then else fi test echo export cat sed exit ';
     1  4    9    14 17   22   27     34  38  42

Above construct is tighter than an array of words and looping
through the array, testing for membership!
}
        p := posBM( W , Sh_Words);      {v1.1 is it a sh cmd?}
        CASE p OF
          0 : Write_StdErr('Unknown sh cmd: ' + Bracketed(S)
                           + CRLF );  {v1.1}
          1 : BEGIN                     {if}  {only the ThenFlag matters...}
{stubbed        IfFlag := TRUE; }             {...for now}
                ThenFlag := FALSE;
{stubbed        ElseFlag := FALSE; }
              END;
          4 : BEGIN                     {then}
                ThenFlag := TRUE;
{stubbed        ElseFlag := FALSE; }
              END;
          9 : BEGIN                     {else}
{stubbed        ElseFlag := TRUE; }
                ThenFlag := FALSE;
              END;
         14 : BEGIN                     {fi}
{stubbed        IfFlag := FALSE; }
                ThenFlag := FALSE;
{stubbed        ElseFlag := FALSE; }
              END;
         17,27 : ;                      {gobble test's, export's}
         22 : BEGIN                     {echo}
                IF NOT ThenFlag         {All then's seem to be bad news ..}
                THEN BEGIN              {..and who wants to hear bad news?}
                  Delete(S,1,5);        {gobble the 'echo '}
                  Write_StdErr(S + CRLF); {v1.1 Display string to StdErr}
                END;
              END;
         34,                            {cat,}
         38 : Extract_Member;           {sed: write out the member}
         42 : SharEof := TRUE;          {exit: finished}
        END;  {case}
      END;  {While NOT SharEof}

    END;  {of Sh}



  PROCEDURE Unshar_File;
    VAR FName : PathStr;
    BEGIN
      FName := curr^.Dir + curr^.SrchRec.Name;  {full filename}
      Write_StdErr('shar: processing ' + FName + CRLF);

      Assign(InFile, FName);
      Reset(InFile);                    {open input file}
      SharEof := FALSE;                 {init file Eof flag}
      line := 0;                        {Init line counter}

      { First look for the header start.  Could be text or other
        junk from mailers, etc.}

      Repeat
        Readln_Eof
      Until SharEof                     {hit physical .shr EOF}
      OR ( (slen <> 0) AND (S[1] IN ['#',':']) );  {or we have a header line}

      Sh;                               {process sh commands}

      Close(InFile);                    {neaten up}

    END;  {of UnShar_File}




  BEGIN  {UnShar}

    IF argc = 1 THEN BEGIN              {just '-u', no names}
      Args[1] := '*.SHR';               {default}
      Args[2] := '';                    {insure no overruns}
    END
    ELSE BEGIN                          {at least one target filename}
      Dec(argc);                        {discard first arg ('-u')}
      FOR argv := 1 TO argc DO          {do argc-1 shifts}
        Args[argv] := Args[SUCC(argv)]; {Shift all args down one}
      Args[SUCC(argc)] := '';           {blank to insure no overruns}

      FOR argv := 1 TO argc DO BEGIN    {expand to .SHR if required}
        IF posCH('.',Args[argv]) = 0    {v1.1 no file.typ separator}
        THEN Args[argv] := Args[argv] + '.SHR';  {so force it}
      END;
    END;

    Find_All;                           {create array of target files}

(*
    Write_StdErr('target files: ');     {v1.1 A little informative..}
    curr := head;                       {..wildcard info}
    S := '';                            {v1.1 clear output string}
    WHILE curr <> NIL DO BEGIN
      S := S + curr^.SrchRec.Name;      {build a string of names}
      curr := curr^.flink;              {bump to next name}

      IF LENGTH(S) > 60 THEN BEGIN      {string's long enough...}
        Write_StdErr(S + CRLF);         {...so display the names}
        S := '';                        {...and clear the string}
      END
      ELSE IF curr <> NIL               {isn't last name...}
      THEN S := S + ', ';               {..so separate names neatly}
    END;

    IF S <> '' THEN Write_StdErr(S + CRLF);  {v1.1 display last partial string}
*)
    Show_TargetNames;                   {v1.1}
    curr := head;                       {start with first filename}
    WHILE curr <> NIL DO BEGIN
      UnShar_File;                      {do them all}
      curr := curr^.flink;              {next file ptr}
    END;

  END;  {of UnShar}


PROCEDURE Shar;
  {We're creating a shar file to StdOut}
  VAR
    FName : PathStr;
    S : String;
    err : INTEGER;

  PROCEDURE Write_Header;
    {Output shar header and filenames}
    VAR i : INTEGER;
    BEGIN
(*
     Writeln(Hdr1);                   {7 separate arrays of char ...}
     Writeln(Hdr2);                   {... what a kludge ...}
     Writeln(Hdr3);
     Writeln(Hdr4);
     Writeln(Hdr5);
     Writeln(Hdr6);
     Writeln(Hdr7);
*)
     FOR i := 1 TO NR_HDRLINES DO
       Write(Hdr[i]);

{ The rest of the header oughtta look like this:
#    test1.doc
#    test2.doc
#    test3.doc
# This archive created: Mon Apr 17 11:30:47 1989
}
      curr := head;                     {first filename}
      WHILE curr <> NIL DO
      WITH curr^ DO BEGIN
        WriteLn( '#',^I,SrchRec.Name);  {list them all, neatly}
        curr := curr^.flink;            {next filename}
      END;
      {I don't feel like hacking all the code it takes
      to add the pretty date/time line .. YOU do it!
      }
      Writeln('# This archive created: Mon Apr 1 00:00:01 2001', {stubbed}
              ' by Joe Isuzu');         {put your name here!}

    END;  {of Write_Header}


  BEGIN  {Shar}

    Find_All;                             {load dynamic array of wildcard
                                           filenames}
    Show_TargetNames;                     {v1.1}

    Write_Header;                         {output the shar header}

    curr := head;                         {start with first filename}
    WHILE curr <> NIL DO BEGIN

      FName := curr^.Dir + curr^.SrchRec.Name;  {full filename}
      Write_StdErr('shar: adding ' + FName + CRLF);  {v1.1}

      Assign(InFile, FName);
      Reset(InFile);                      {open input file}
      Writeln('cat << \SHAR_EOF > ' + curr^.SrchRec.Name); {'test1.doc'}
      WHILE NOT Eof(InFile) DO BEGIN
        {$I-}  Readln(InFile,S);
        IF IoResult <> 0 THEN BEGIN
          Write_StdErr('Read error: ' + Bracketed(FName) + CRLF);  {v1.1}
          Close(InFile);
        {$I+}
          IF IoResult <> 0 THEN;           {we don't care}
          Exit;                            {die}
        END;

        Writeln(S);                        {let Turbo and DOS worry
                                            about output errors}
      END;

      Writeln('SHAR_EOF');
      {$I-}  Close(InFile);  {$I+}        {close input file}
      IF IoResult <> 0 THEN ;             {we don't care}

      curr := curr^.flink;                {next file ptr}
    END;  {wend}

    Writeln('#    End of shell archive');   {neat ending}
    Writeln('exit 0');                    {even neater}
  END;  {of Shar}


BEGIN  {Main}
  Get_Args;                             {process cmdline args (may die)}

  IF Args[1] = '-U'                     {He wants us to unshar something...}
  THEN UnShar                           {...so do it}
  Else Shar;                            {ok, shar everything}

END.