home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / PROG / REXX / CMD / FT.ZIP / FT.CMD next >
Encoding:
Text File  |  1994-02-05  |  9.4 KB  |  338 lines
  1. /* **************************************************************
  2.    File name: FT.CMD
  3.  
  4.    Version: 1.0
  5.  
  6.    Description: Rexx Program which modifies the type of a file,
  7.                 by modifying the file's .TYPE EA
  8.  
  9.    Usage: FT [FileSpec] [/a "Type" "Type"...] [/r "Type" "Type"...] [/d "Type"] [/s] [/l] [/?]
  10.           /a - Adds all following type(s)
  11.           /r - Removes all following type(s)
  12.           /d - Sets the default type
  13.           /s - Process files in subdirectories
  14.           /l - Lists the type(s) of each file
  15.           /? - Help screen
  16.   ************************************************************** */
  17.  
  18. /* Get the command line arguments */
  19. parse arg FileSpec TheRest
  20. TheRest = ArgToUpper(TheRest)
  21. DefaultType = ""
  22. DeleteTypes = ""
  23. AddTypes = ""
  24. List = 0
  25. if Pos("/L", TheRest) \= 0 then
  26. do
  27.   List = 1
  28.   parse var TheRest TheRest "/L" EndBit
  29.   TheRest = TheRest || EndBit
  30. end
  31. if Pos("/S", TheRest) \= 0 then
  32. do
  33.   parse var TheRest TheRest "/S"
  34.   FileTreeOptions = "FOS"
  35. end
  36. else
  37.   FileTreeOptions = "FO"
  38. if Pos("/D", TheRest) \= 0 then
  39.   parse var TheRest TheRest "/D" DefaultType
  40. if Pos("/R", TheRest) \= 0 then
  41.   parse var TheRest TheRest "/R" DeleteTypes
  42. if Pos("/A", TheRest) \= 0 then
  43.   parse var TheRest TheRest "/A" AddTypes
  44.  
  45. /* Add the necessary support functions */
  46. call RxFuncAdd "SysIni", "RexxUtil", "SysIni"
  47. call RxFuncAdd "SysFileTree", "RexxUtil", "SysFileTree"
  48. call RxFuncAdd "SysGetEA", "RexxUtil", "SysGetEA"
  49. call RxFuncAdd "SysPutEA", "RexxUtil", "SysPutEA"
  50. call RxFuncAdd "SysGetKey", "RexxUtil", "SysGetKey"
  51.  
  52. say "***** FT.CMD - File Type Modifier V1.0 *****"
  53. say "Copyright (c) Lachlan O'Dea 1994"
  54.  
  55. if FileSpec = "" | FileSpec = "/?" then
  56. do
  57.   call DisplayHelp
  58.   exit
  59. end
  60.  
  61. /* Find all the file types defined in the system */
  62. Result = SysIni("USER", "PMWP_ASSOC_TYPE", "ALL:", "AllTypes")
  63.  
  64. /* Check parameters to find types to add */
  65. i = 0
  66. do while AddTypes \= ""
  67.   i = i + 1
  68.   parse var AddTypes '"'Add.i'"' AddTypes  /* Removes the first type of AddTypes and puts it in Add.i */
  69.   Add.i = FindType(Add.i)
  70.   if Add.i = "" then
  71.     i = i - 1
  72. end
  73. Add.0 = i
  74.  
  75. /* Check parameters to find types to delete */
  76. i = 0
  77. do while DeleteTypes \= ""
  78.   i =i + 1
  79.   parse var DeleteTypes '"'Delete.i'"' DeleteTypes
  80.   Delete.i = FindType(Delete.i)
  81.   if Delete.i = "" then
  82.     i = i - 1
  83. end
  84. Delete.0 = i
  85.  
  86. /* Find the files which must be changed */
  87. Result = SysFileTree(FileSpec, "Files", FileTreeOptions)
  88.  
  89. /* Make the appropriate changes to EAs of each file */
  90. do i = 1 to Files.0
  91.   say
  92.   say "Processing: " || Files.i
  93.   /* Extract existing type info */
  94.   Result = SysGetEA(Files.i, ".TYPE", "OrigEA")
  95.  
  96.   /* Store original types in OrigEntry */
  97.   if OrigEA = "" then
  98.   do
  99.     OrigEntry.0 = 0
  100.     NewEA = "DFFF00000000"x
  101.   end
  102.   else
  103.   do
  104.     parse var OrigEA 5 NumEntriesLoChar 6
  105.     OrigEntry.0 = C2D(NumEntriesLoChar)
  106.     parse var OrigEA 7 TypeInfo
  107.     do j = 1 to OrigEntry.0
  108.       parse var TypeInfo . 3 LengthLoChar 4 . 5 TypeInfo
  109.       Index = C2D(LengthLoChar)
  110.       OrigEntry.j = SubStr(TypeInfo, 1, Index)
  111.       TypeInfo = DelStr(TypeInfo, 1, Index)
  112.     end  /* do j */
  113.     NewEA = OrigEA
  114.   end
  115.  
  116.   /* Add types not already present */
  117.   NumEntriesAdded = 0
  118.   do j = 1 to Add.0
  119.     call Match Add.j
  120.     if \Word(Result, 1) then
  121.     do
  122.       Index = Length(NewEA)
  123.       NewEA = Insert("FDFF"x || D2C(Length(Add.j)) || "00"x || Add.j, NewEA, Index)
  124.       NumEntriesAdded = NumEntriesAdded + 1
  125.       say "  Added: " || Add.j
  126.       OrigEntry.0 = OrigEntry.0 + 1
  127.       Index = OrigEntry.0
  128.       OrigEntry.Index = Add.j
  129.     end
  130.     else
  131.       say '  * The type "'Add.j'" was not added, as it was already present'
  132.   end
  133.  
  134.   /* Delete specified types if they are present */ 
  135.   do j = 1 to Delete.0
  136.     call Match Delete.j
  137.     parse var Result IsMatch EntryNum
  138.     if IsMatch then
  139.     do
  140.       call FindEntry NewEA, EntryNum
  141.       parse var Result Index Size
  142.       NewEA = DelStr(NewEA, Index, Size)
  143.       NumEntriesAdded = NumEntriesAdded - 1
  144.       say "  Deleted: " || Delete.j
  145.       OrigEntry.0 = OrigEntry.0 - 1
  146.       do k = EntryNum to OrigEntry.0
  147.         Index = k + 1
  148.         OrigEntry.k = OrigEntry.Index
  149.       end  /* do k */
  150.     end  /* if IsMatch */
  151.     else
  152.       say '  * The type "'Delete.j'" was not deleted, as it was not present'
  153.   end  /* do j */
  154.  
  155.   /* Update number of entries, if necessary */
  156.   if NumEntriesAdded \= 0 then
  157.   do
  158.     NewEA = DelStr(NewEA, 5, 2)   /* Removes the old Number of entries */
  159.     NewEA = Insert(D2C(OrigEntry.0) || "00"x, NewEA, 4, 2)
  160.   end
  161.  
  162.   if DefaultType \= "" then
  163.   do
  164.     parse var DefaultType '"'DefaultType'"'
  165.     DefaultType = FindType(DefaultType)
  166.     if DefaultType \= "" then
  167.     do
  168.       call Match DefaultType
  169.       parse var Result IsMatch EntryNum
  170.       if IsMatch then
  171.       do
  172.         call FindEntry NewEA, EntryNum
  173.         parse var Result Index Size
  174.         NewEA = DelStr(NewEA, Index, Size)
  175.         NewEA = Insert("FDFF"x || D2C(Length(DefaultType)) || "00"x || DefaultType, NewEA, 6)
  176.         say "  Set the default type to "DefaultType
  177.         do j = EntryNum by -1 to 2
  178.           k = j - 1
  179.           OrigEntry.j = OrigEntry.k
  180.         end
  181.         OrigEntry.1 = DefaultType
  182.       end
  183.       else
  184.         say "  * The type you specified as default is not associated with this file"
  185.     end
  186.   end  /*  if  */
  187.  
  188.   /* Now write out the modified EA */
  189.   call SysPutEA Files.i, ".TYPE", NewEA
  190.  
  191.   if List then
  192.   do
  193.     say "  " || OrigEntry.0 || " Types present:"
  194.     do j = 1 to OrigEntry.0
  195.       say "    "OrigEntry.j
  196.     end
  197.   end
  198. end  /* do i */
  199.  
  200. say
  201. say "*** Finished ***"
  202. exit
  203.  
  204.  
  205. /* ************************************************************** */
  206. /* Function: FindType */
  207. FindType:
  208.   procedure expose AllTypes.
  209.   parse arg Key
  210.  
  211.   BestIndex = 0
  212.   NumEqual = 1
  213.   do i = 1 to AllTypes.0
  214.     Index = Compare(Key, AllTypes.i)
  215.     if Index = 0 then
  216.       return AllTypes.i
  217.     if Index > BestIndex then
  218.     do
  219.       BestIndex = Index
  220.       BestMatch = i
  221.       NumEqual = 1
  222.       EqualStr.1 = AllTypes.i
  223.     end
  224.     else
  225.       if Index = BestIndex then
  226.       do
  227.         NumEqual = NumEqual + 1
  228.         EqualStr.NumEqual = AllTypes.i
  229.       end
  230.   end  /* do i */
  231.   if NumEqual > 1 then
  232.   do
  233.     say '  *** The type you specified, "'Key'", has 'NumEqual' possibilities:'
  234.     EqualStr.0 = "None"
  235.     Index = 0
  236.     InKey = "0D"x
  237.     do until InKey = "0D"x
  238.       do i = Index to NumEqual
  239.         if (i - Index) >= 20 | (Index \=0 & i = NumEqual) then
  240.         do
  241.           if (i - Index) < 20 then
  242.             say "    ("NumEqual") " || EqualStr.NumEqual
  243.           say "    * U: previous screen  D: next screen  <Enter>: Make a choice"
  244.           InKey = SysGetKey("NOECHO")
  245.           select
  246.             when (Inkey = "U" | InKey = 'u') & Index >= 20 then
  247.               Index = Index - 20
  248.             when (Inkey = "D" | Inkey = "d") & Index <= NumEqual - 20 then
  249.               Index = Index + 20
  250.             otherwise
  251.               nop
  252.           end
  253.           leave
  254.         end
  255.         say "    ("i") " || EqualStr.i
  256.       end
  257.     end
  258.     say "  Enter a selection"
  259.     pull Choice
  260.     if Choice \= 0 then
  261.       return EqualStr.Choice
  262.     else
  263.       return ""
  264.   end
  265.   return AllTypes.BestMatch
  266. /* ************************************************************** */
  267.  
  268.  
  269. /* ************************************************************** */
  270. /* Subroutine: FindEntry */
  271. FindEntry:
  272.   procedure
  273.   parse arg EA, EntryNum
  274.  
  275.   Index = 1
  276.   do EntryNum
  277.     Index = Pos("FDFF"x, EA, Index+1)
  278.     if Index = 0 then
  279.       return 0
  280.   end
  281.   Size = C2D(SubStr(EA, Index+2, 1)) + 4  /* Add 4 for type and size info */
  282.   return Index Size
  283. /* ************************************************************** */
  284.  
  285.  
  286. /* ************************************************************** */
  287. /* Function: Match */
  288. Match:
  289.   procedure expose OrigEntry.
  290.   parse arg SearchEntry
  291.  
  292.   do i = 1 to OrigEntry.0
  293.     if OrigEntry.i = SearchEntry then
  294.       return 1 i
  295.   end
  296.   return 0
  297. /* ************************************************************** */
  298.  
  299.  
  300. /* ************************************************************** */
  301. /* Function: ArgToUpper */
  302. ArgToUpper:
  303.   procedure
  304.   parse arg str
  305.  
  306.   MakeUpper = 1
  307.   RetStr = ""
  308.   do i = 1 to Length(str)
  309.     chr = SubStr(str, i, 1)
  310.     if chr = '"' then
  311.       if MakeUpper then
  312.         MakeUpper = 0
  313.       else
  314.         MakeUpper = 1
  315.     if MakeUpper & chr >= 'a' & chr <= 'z' then
  316.       chr = D2C(C2D(chr) - 32)
  317.     RetStr = RetStr || chr
  318.   end /* do i */
  319.   return RetStr
  320. /* ************************************************************** */
  321.  
  322.  
  323. /* ************************************************************** */
  324. /* Function: DisplayHelp */
  325. DisplayHelp:
  326.   say "Usage:"
  327.   say '   FT [/a "Type" "Type"...] [/r "Type" "Type"...] [/d "Type"] [/s] [/l] [/?]'
  328.   say "   /a Specifies the types to add"
  329.   say "   /r Specifies the types to remove"
  330.   say "   /d Specifies a default type (must be already associated with file)"
  331.   say "   /s Process files in subdirectories"
  332.   say "   /l Lists the types associated with the file after processing"
  333.   say "   /? for this help message"
  334.   say "   Type names must be enclosed in quotes"
  335.   say "   If type name is not complete, it is matched with the closest one"
  336.   return
  337. /* ************************************************************** */
  338.