home *** CD-ROM | disk | FTP | other *** search
/ Zodiac Super OZ / MEDIADEPOT.ISO / FILES / 13 / MLUTL100.ZIP / ML_INC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-12  |  8KB  |  320 lines
  1. (* This is an "INCLUDE" file for "MLAdd.pas" and "MLDrop.pas", by DDA *)
  2.  
  3. TYPE
  4.   ListLink = ^NameRecord;
  5.   NameRecord = RECORD
  6.                  Name   : STRING[80];
  7.                  Next   : ListLink;
  8.                END;
  9.  
  10. {$IFDEF MLDROP}
  11.  
  12. PROCEDURE ExitOnError (err : BYTE; msg : STRING);
  13. CONST
  14.   NL = #13#10;
  15. BEGIN
  16.   WriteLn ('MLDrop v1.00 - Free DOS utility: Drop names from an Internet mailing list.');
  17.   WriteLn ('July 12th, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.'+NL);
  18.   WriteLn ('Usage:   MLDrop  MasterList  drop_list(s)'+NL);
  19.   WriteLn ('Example: MLDrop  friends  enemies'+NL);
  20.   IF err > 0 THEN BEGIN
  21.     IF err > 1 THEN Write(#7);
  22.     WriteLn ('Error encountered (#', err, '):');
  23.     WriteLn (msg);
  24.   END;
  25.   Halt (err);
  26. END;
  27.  
  28. {$ENDIF}
  29. {$IFDEF MLADD}
  30.  
  31. PROCEDURE ExitOnError (err : BYTE; msg : STRING);
  32. CONST
  33.   NL = #13#10;
  34. BEGIN
  35.   WriteLn ('MLAdd v1.00 - Free DOS utility: Add names to an Internet mailing list.');
  36.   WriteLn ('July 12th, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.'+NL);
  37.   WriteLn ('Usage:   MLAdd  MasterList  [add_list(s)]'+NL);
  38.   WriteLn ('Example: MLAdd  friends  buddies'+NL);
  39.   IF err > 0 THEN BEGIN
  40.     IF err > 1 THEN Write(#7);
  41.     WriteLn ('Error encountered (#', err, '):');
  42.     WriteLn (msg);
  43.   END;
  44.   Halt (err);
  45. END;
  46.  
  47. {$ENDIF}
  48.  
  49. PROCEDURE CheckIO;
  50. BEGIN
  51.   IF IOResult <> 0 THEN ExitOnError (7, 'File handling error.');
  52. END;
  53.  
  54. FUNCTION Upper (lstr : STRING): STRING;
  55.   PROCEDURE UpFast (VAR Str: STRING);  {** from SWAG **}
  56.   INLINE($8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('a')/Ord('z')/
  57.        $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$6C/$FF/$20/$E2/$F1/$8E/$DA);
  58. BEGIN
  59.   UpFast (lstr);
  60.   Upper := lstr;
  61. END;
  62.  
  63. FUNCTION IsFile (CONST FileName: PATHSTR): BOOLEAN;
  64. VAR
  65.   Attr  : WORD;
  66.   cFile : FILE;
  67. BEGIN
  68.   Assign (cFile, FileName);
  69.   GetFAttr (cFile, Attr);
  70.   IF (DosError = 0) AND ((Attr AND Directory) <> Directory)
  71.     THEN IsFile := TRUE
  72.     ELSE IsFile := FALSE;
  73. END;
  74.  
  75. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  76. VAR
  77.   Attr  : WORD;
  78.   cFile : FILE;
  79. BEGIN
  80.   Assign (cFile, FileName);
  81.   GetFAttr (cFile, Attr);
  82.   IF (DosError = 0) AND ((Attr AND Directory) = Directory)
  83.     THEN IsDir := TRUE
  84.     ELSE IsDir := FALSE;
  85. END;
  86.  
  87. PROCEDURE EraseFile (CONST FileName : STRING);
  88. VAR
  89.   cFile : FILE;
  90. BEGIN
  91.   IF IsFile (FileName) THEN BEGIN
  92.     Assign (cFile, FileName);
  93.     SetFAttr (cFile, 0);
  94.     Erase (cFile); CheckIO;
  95.   END;
  96. END;
  97.  
  98. FUNCTION GetFilePath (CONST PSTR: STRING; VAR sDir: DIRSTR): PATHSTR;
  99. VAR
  100.   jPath     : PATHSTR;  { file path,       }
  101.   jDir      : DIRSTR;   {      directory,  }
  102.   jName     : NAMESTR;  {      name,       }
  103.   jExt      : EXTSTR;   {      extension.  }
  104. BEGIN
  105.   jPath := PSTR;
  106.   IF jPath = '' THEN jPath := '*.*';
  107.   IF (NOT (jPath [Length (jPath)] IN [':', '\'])) AND IsDir (jPath) THEN
  108.     jPath := jPath + '\';
  109.   IF (jPath [Length (jPath)] IN [':', '\']) THEN
  110.     jPath := jPath + '*.*';
  111.  
  112.   FSplit (FExpand (jPath), jDir, jName, jExt);
  113.   jPath := jDir + jName+ jExt;
  114.  
  115.   sDir := jDir;
  116.   GetFilePath := jPath;
  117. END;
  118.  
  119. FUNCTION FindName (Address: STRING): STRING;
  120. VAR
  121.   aPos, first, last : BYTE;
  122.   DONE : BOOLEAN;
  123.  
  124. BEGIN
  125.   aPos := Pos ('@', Address);
  126.   IF aPos > 0 THEN
  127.   BEGIN
  128.     first := aPos;
  129.     DONE := FALSE;
  130.     WHILE NOT DONE DO
  131.       IF ((first-1) = 0) OR (Address[first-1] IN [#32,#34,#40,#44,#58,#60,#91,#255])
  132.         THEN DONE := TRUE
  133.         ELSE Dec (first);
  134.  
  135.     last := aPos;
  136.     DONE := FALSE;
  137.     WHILE NOT DONE DO
  138.       IF ((last+1) > Length (Address)) OR (Address[last+1] IN [#32,#34,#41,#44,#58,#62,#93,#255])
  139.         THEN DONE := TRUE
  140.         ELSE Inc (last);
  141.  
  142.     Address := Copy (Address, first, 1+last-first);
  143.   END
  144.   ELSE
  145.     Address := '';
  146.  
  147.   FindName := Address;
  148. END;
  149.  
  150. PROCEDURE AddToList (VAR NameList: ListLink; fName: STRING; VAR TotalMems: WORD);
  151. VAR
  152.   NewName    : STRING;
  153.   Anchor,
  154.   NameNode : ListLink;
  155.   InFile     : TEXT;
  156.  
  157. BEGIN
  158.   Anchor := NameList;
  159.   IF NameList <> NIL THEN    { advance to end of list }
  160.     WHILE (NameList^.Next) <> NIL DO NameList := NameList^.Next;
  161.  
  162.   NameNode := NIL;
  163.  
  164.   IF IsFile (fName) THEN BEGIN
  165.     Assign (InFile, fName);
  166.     Reset (InFile); CheckIO;
  167.     Write ('Reading names to add from: ', fName, ', please wait ... ');
  168.  
  169.     WHILE NOT SeekEof (InFile) DO
  170.     BEGIN
  171.       ReadLn (InFile, NewName); CheckIO;   { fill in new data }
  172.       NewName := FindName (NewName);       { extract email address from line }
  173.  
  174.       IF (Length (NewName) > 1) AND (NewName[1] <> '@') THEN
  175.       BEGIN
  176.  
  177.         Inc (TotalMems);
  178.         New (NameNode);
  179.  
  180.         NameNode^.Name := Copy (NewName, 1, 80);
  181.         NameNode^.Next := NIL;
  182.  
  183.         IF NameList = NIL                    { add to end of list }
  184.           THEN Anchor := NameNode            { point to first node }
  185.           ELSE NameList^.Next := NameNode;
  186.  
  187.         NameList := NameNode;                { point to last node }
  188.       END;
  189.     END; {while}
  190.  
  191.     Close (InFile); CheckIO;
  192.     NameList := Anchor;
  193.   END;
  194.  
  195.   WriteLn ('done!');
  196.   NameList := Anchor;
  197. END;
  198.  
  199. PROCEDURE EditList (VAR NameList: ListLink; VAR TotalMems: WORD);
  200. VAR
  201.   TempName : STRING;
  202.   Anchor,
  203.   TempNode,
  204.   Chain : ListLink;
  205. BEGIN
  206.   Anchor := NameList;
  207.  
  208.   WHILE (NameList <> NIL) AND (NameList^.Next <> NIL) DO
  209.   BEGIN
  210.     { Take one name at a time, and go through rest of list, deleting dups }
  211.  
  212.     TempName := Upper (NameList^.Name);
  213.  
  214.     Chain := NameList;
  215.     WHILE (Chain <> NIL) AND (Chain^.Next <> NIL) DO
  216.     BEGIN
  217.       IF Upper (Chain^.Next^.Name) = TempName THEN
  218.       BEGIN
  219.         TempNode := Chain^.Next;
  220.         Chain^.Next := Chain^.Next^.Next;
  221.         Dispose (TempNode);
  222.         Dec (TotalMems, 1);
  223.       END
  224.       ELSE
  225.         Chain := Chain^.Next;
  226.     END;
  227.  
  228.     NameList := NameList^.Next;
  229.   END;
  230.   NameList := Anchor;
  231. END;
  232.  
  233. PROCEDURE WriteList (VAR NameList: ListLink; fName: STRING; VAR TotalMems: WORD);
  234. VAR
  235.   MemList : TEXT;
  236.   Chain : ListLink;
  237. BEGIN
  238.   Assign (MemList, fName);
  239.   Rewrite (MemList);
  240.   IF (IOResult <> 0) THEN
  241.     ExitOnError (4, 'Cannot create file for new master mailing list.');
  242.  
  243.   WHILE NameList <> NIL DO
  244.   BEGIN
  245.     WriteLn (MemList, NameList^.Name);
  246.     Chain := NameList;
  247.     NameList := NameList^.Next;
  248.     Dispose (Chain);
  249.   END;
  250.   Close (MemList); CheckIO;
  251. END;
  252.  
  253. PROCEDURE DropFromList (VAR NameList: ListLink; fName: STRING; VAR TotalMems: WORD);
  254. VAR
  255.   TempName    : STRING;
  256.   Anchor,
  257.   TempNode,
  258.   Chain : ListLink;
  259.   InFile     : TEXT;
  260.  
  261. BEGIN
  262.   Anchor := NameList;
  263.  
  264.   IF IsFile (fName) THEN BEGIN
  265.     Assign (InFile, fName);
  266.     Reset (InFile); CheckIO;
  267.     WriteLn ('Reading names to drop from: ', fName);
  268.  
  269.     WHILE NOT SeekEof (InFile) DO
  270.     BEGIN
  271.       ReadLn (InFile, TempName); CheckIO;   { fill in new data }
  272.       TempName := FindName (TempName);       { extract email address from line }
  273.  
  274.       IF (Length (TempName) > 1) AND (TempName[1] <> '@') THEN
  275.       BEGIN
  276.         TempName := Upper (TempName);
  277.  
  278.         NameList := Anchor;
  279.         IF (NameList <> NIL) THEN
  280.         BEGIN
  281.           Chain := NameList;
  282.           { Take temp name, and go through entire list, deleting dups }
  283.  
  284.           WHILE (Chain <> NIL) AND (Upper (Chain^.Name) = TempName) DO
  285.           BEGIN
  286.             TempNode := Chain;
  287.  
  288.             Chain := Chain^.Next;  { advance EVERYTHING! }
  289.             NameList := Chain;
  290.             Anchor := Chain;
  291.  
  292.             Dispose (TempNode);
  293.             Dec (TotalMems, 1);
  294.           END;
  295.  
  296.           WHILE (Chain <> NIL) AND (Chain^.Next <> NIL) DO
  297.           BEGIN
  298.             IF Upper (Chain^.Next^.Name) = TempName THEN
  299.             BEGIN
  300.               WriteLn ('Dropped "', Chain^.Next^.Name, '" from list.');
  301.               TempNode := Chain^.Next;
  302.               Chain^.Next := Chain^.Next^.Next;
  303.               Dispose (TempNode);
  304.               Dec (TotalMems, 1);
  305.             END
  306.             ELSE
  307.               Chain := Chain^.Next;
  308.           END;
  309.  
  310.         END;
  311.       END;
  312.     END;
  313.  
  314.     WriteLn ('Finished dropping names.');
  315.     Close (InFile); CheckIO;
  316.   END;
  317.  
  318.   NameList := Anchor;
  319. END;
  320.