home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / com / mail2pm / unqwk.cmd < prev    next >
Encoding:
Text File  |  1993-07-11  |  5.1 KB  |  152 lines
  1. /*
  2.     MR/2 - UNQWK.CMD
  3.  
  4.     Author:     Nick Knight
  5.     Created:    03/26/93
  6.     Usage:        unqwk packet.qwk
  7.     Purpose:    Unqwk.cmd will analyze the file named as a parameter.
  8.                 It will check the file for a valid archiver signiture
  9.                 and branch to an appropriate unarchiving command.  This
  10.                 file, as is, should accomodate most existing QWK packet
  11.                 archivers.    This utility is easily extensible, either
  12.                 by the original author, or by anyone with an urge to
  13.                 tinker.
  14.  
  15.     This was my first REXX program.  I'm sure it will be enhanced and
  16.     extended ... and I'm sure there are plenty of inefficiencies.  Feel
  17.     free to provide me with pointers, or just send me a copy of any
  18.     improvements/enhancements.
  19.  
  20.     The author claims no copyright to this particular REXX script.
  21.     Feel free to copy it and/or use it for other purposes.    I *would*
  22.     like to see the results of any improvements to it.
  23.  
  24.     US Mail:    Nick Knight, 1823 David Ave.,  Parma, Ohio 44134
  25.     Fidonet:    1:157/2 or 1:/157/200
  26.     Internet:    nick.knight@pcohio.com
  27.     Compuserve: 76066,1240
  28.     BBS:        Private messages on Nerd's Nook, 356-1772 or 356-1872
  29. */
  30.  
  31. /***********************************************************************/
  32. /*        A R C H I V E R     C O M M A N D     D E F I N I T I O N S       */
  33. /***********************************************************************/
  34. /*    To add support for a new unpacker, simply supply a new command
  35.     definition here.  The file name to unpack will be appended to
  36.     the end of the supplied command.  You can customize in more detail
  37.     by modifying the code directly, if need be.
  38. */
  39.  
  40. path = ''
  41.  
  42. zip_command =    'pkunzip -o'
  43. arj_command =    'arj x'
  44. zoo_command =    'zoo x'
  45. lharc_command = 'lha x'
  46. lha_command =    'lh x'
  47. arc_command =    'arc x'
  48.  
  49.  
  50. /***********************************************************************/
  51. /*                    U N Q W K     F I L E N A M E                       */
  52. /***********************************************************************/
  53. /*
  54.     Returns -1 if it the file appears not to be a packed "archive".
  55.     Returns -2 if the file doesn't exist
  56.     Otherwise, the "archive_id" is returned (1 -> 6).
  57. */
  58.  
  59. parse arg filename
  60.  
  61. /*
  62.   06/10/93 - Check for long file name - copy to 'shorter' 8.3 name for packer
  63. */
  64.  
  65. flongname = length(filename) - lastpos('\',filename) - 12
  66. if flongname < 0 then do
  67.     flongname = length(filename) - pos('.',filename) - 3
  68. end
  69. if flongname > 0 then do
  70.     'copy "'filename'" MR2$TMP.QWK'
  71.     filename = 'MR2$TMP.QWK'
  72.     flongname = 1
  73. end
  74.  
  75. if stream(filename,'c','query exists') = "" then do
  76.     return -2
  77. end
  78.  
  79.     /*
  80.     Book says file is open in read/write by default.  This worried me,
  81.     although my tests proved that the file's datestamp remained unchanged.
  82.     Just to be safe, I wanted to open the file in read-only mode.
  83.     */
  84. status = stream(filename,'c','open read')           /* read only */
  85. header = charin(filename,1,16)
  86.  
  87.     /*    If it doesn't have at least 16 chars, it probably isn't real */
  88. if chars(filename) = 0 then do
  89.     status = stream(filename,'c','close')
  90.     return -1
  91. end
  92.  
  93. status = stream(filename,'c','close')       /* Close the file - Important! */
  94.  
  95. archiver_id = which_archiver(header)        /* call analyzer function, below */
  96.  
  97. select                                        /* execute the corresponding command */
  98.     when archiver_id = -1 then do
  99.         say "UNKNOWN ARCHIVE TYPE: " filename
  100.         return -1
  101.     end
  102.     when archiver_id = 1 then path || zip_command '"'||filename'"'
  103.     when archiver_id = 2 then path || arj_command filename
  104.     when archiver_id = 3 then path || zoo_command filename
  105.     when archiver_id = 4 then path || lharc_command filename
  106.     when archiver_id = 5 then path || lha_command filename
  107.     when archiver_id = 6 then path || arc_command filename
  108.     otherwise
  109. end
  110.  
  111. if RC <> 0 then return RC
  112.  
  113. idfile = "archiver.id"                      /* important for packing replies */
  114. status = lineout(idfile,archiver_id,1)        /* record unpacker id so */
  115. status = lineout(idfile)                    /* compatible packer can be used */
  116.  
  117. if flongname > 0 then
  118.     'del MR2$TMP.QWK'
  119.  
  120. return archive_id                            /* return the ID type */
  121.  
  122.  
  123. /***********************************************************************/
  124. /*                   W H I C H     A R C H I V E R                       */
  125. /***********************************************************************/
  126. /*
  127.     Returns -1 if it can't tell, otherwise it returns the archiver id
  128.     that I've assigned to the ones I know about.  Others can be easily
  129.     added.    Some of this may not be correct (lha vs lharc), but I tested
  130.     as much of it as I could.  Looks OK.
  131. */
  132.  
  133. which_archiver:
  134.  
  135. parse arg header                /* header is the first 16 bytes of file */
  136.  
  137. select
  138.     when substr(header,1,2) = "PK" then id = 1              /* PKWare */
  139.     when substr(header,1,1) = '`' && substr(header,2,1) = '\xEA' then id = 2 /* ARJ */
  140.     when substr(header,1,3) = "ZOO" then id = 3             /* ZOO */
  141.     when substr(header,3,5) = "-lh0-" then id = 4           /* LHARC */
  142.     when substr(header,3,5) = "-lh1-" then id = 4           /* LHARC */
  143.     when substr(header,3,3) = "-lh" then id = 5             /* LHA */
  144.     when c2d(substr(header,1,1)) = 26 then id = 6            /* ARC */
  145.     otherwise
  146.         id = -1             /* Archiver unknown or not an archive */
  147. end
  148.  
  149. return id
  150.  
  151.  
  152.