home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MKMSG104 / MSGIMPRT / MSGIMPRT.PAS < prev   
Pascal/Delphi Source File  |  1994-01-09  |  7KB  |  215 lines
  1. Program MsgImprt;
  2.  
  3. {$I MKB.DEF}
  4.  
  5. { Example program for the MKMsg objects                                }
  6.  
  7. { Copyright 1993 by Mark May - Mythical Kingdom Software               }
  8. { MK Tech BBS 513-237-7737     1:110/290      ->MYTHKING               }
  9. { P.O. Box 24808, Huber Heights, OH 45424                              }
  10. { maym@dmapub.dma.org                                                  }
  11.  
  12.  
  13. { You may freely use this code as an example, but should give          }
  14. { appropriate credit to the author.                                    }
  15.  
  16. { Notice that by using OOP and the MKOpen unit, this program will      }
  17. { require absolutely *no* changes as additional message base types     }
  18. { are added.                                                           }
  19.  
  20.  
  21. Uses MKFile, MKString, MKMsgAbs, MKOpen, MKGlobT, MKDos
  22. {$IFDEF WINDOWS}
  23. , MKWCrt;
  24. {$ELSE}
  25. ;
  26. {$ENDIF}
  27.  
  28. Var
  29.   Msg: AbsMsgPtr;                      {Pointer to msg object}
  30.   MsgAreaId: String[128];              {Message Area Id to post msg in}
  31.   MsgFrom: String[50];                 {Author of the message}
  32.   MsgTo: String[50];                   {Who the message is to}
  33.   MsgSubj: String[100];                {Subject of the message}
  34.   OrigAddr: AddrType;                  {Fido-style originating address}
  35.   DestAddr: AddrType;                  {Fido-style destination address}
  36.   MsgFileName: String;                 {File name with message text}
  37.   WildName: String;                    {Search file name given for msg text}
  38.   MsgType: MsgMailType;                {Type of msg to be written}
  39.   Priv: Boolean;                       {Is message private}
  40.   Del: Boolean;                        {Erase msg text file afterwards}
  41.   TxtSearch: FindObj;                  {wildcard processor}
  42.  
  43.  
  44.  
  45. Procedure InitMsgValues;               {initial message values to defaults}
  46.   Begin
  47.   MsgAreaId := '';
  48.   MsgFrom := 'M K Msg Import';
  49.   MsgTo := 'All';
  50.   MsgSubj := 'Automatic Message';
  51.   WildName := 'MsgImprt.Txt';
  52.   MsgType := mmtNormal;
  53.   Priv := False;
  54.   Del := False;
  55.   FillChar(OrigAddr, SizeOf(OrigAddr), #0);
  56.   FillChar(DestAddr, SizeOf(DestAddr), #0);
  57.   End;
  58.  
  59.  
  60. Procedure FixSpaces(Var St: String);   {change underscores to spaces}
  61.   Var
  62.     i: Word;
  63.  
  64.   Begin
  65.   For i := 1 to Length(St) Do
  66.     Begin
  67.     If St[i] = '_' Then
  68.       St[i] := ' ';
  69.     End;
  70.   End;
  71.  
  72.  
  73. Procedure ProcessCmdLine;              {Process command line params}
  74.   Var
  75.     i: Word;
  76.     TmpStr: String;
  77.  
  78.   Begin
  79.   For i := 1 to ParamCount Do
  80.     Begin
  81.     TmpStr := ParamStr(i);
  82.     Case TmpStr[1] of
  83.       '-','/':                         {command line param}
  84.         Begin
  85.         Case UpCase(TmpStr[2]) of
  86.           'F': MsgFrom := Copy(TmpStr, 3, 50);
  87.           'S': MsgSubj := Copy(TmpStr, 3, 100);
  88.           'T': MsgTo := Copy(TmpStr, 3, 50);
  89.           'A': MsgAreaId := Copy(TmpStr, 3, 128);
  90.           'P': Priv := True;
  91.           'E': Del := True;
  92.           'O': If ParseAddr(Copy(TmpStr, 3, 128), OrigAddr, DestAddr) Then;
  93.           'D': If ParseAddr(Copy(TmpStr, 3, 128), DestAddr, OrigAddr) Then;
  94.           Else
  95.             WriteLn('Invalid cmd line param: ', TmpStr);
  96.           End;
  97.         End;
  98.       Else
  99.         Begin                          {Msg Text Filename}
  100.         WildName := TmpStr;
  101.         End;
  102.       End;
  103.     End;
  104.   End;
  105.  
  106.  
  107. Procedure ProcessMsgFile;              {Process text from message file}
  108.   Var
  109.     TF: TFile;                         {Use TFile object for ease of use}
  110.     TmpStr: String;
  111.  
  112.   Begin
  113.   TF.Init;
  114.   If TF.OpenTextFile(MsgFileName) Then
  115.     Begin
  116.     If OpenMsgArea(Msg, MsgAreaId) Then
  117.       Begin
  118.       Msg^.StartNewMsg;
  119.       TmpStr := TF.GetString;
  120.       While TF.StringFound Do
  121.         Begin
  122.         If Length(TmpStr) > 0 Then
  123.           Begin
  124.           Case TmpStr[1] of
  125.             '%': Begin
  126.                  Case UpCase(TmpStr[2]) Of
  127.                    'F': MsgFrom := Copy(TmpStr, 3, 50);
  128.                    'S': MsgSubj := Copy(TmpStr, 3, 100);
  129.                    'T': MsgTo := Copy(TmpStr, 3, 50);
  130.                    'P': Priv := True;
  131.                    'E': Del := True;
  132.                    'O': If ParseAddr(Copy(TmpStr, 3, 128), OrigAddr, DestAddr) Then;
  133.                    'D': If ParseAddr(Copy(TmpStr, 3, 128), DestAddr, OrigAddr) Then;
  134.                    Else
  135.                      Begin
  136.                      Msg^.DoStringLn(TmpStr);
  137.                      End;
  138.                    End;
  139.                  End;
  140.             #1:  Begin
  141.                  Msg^.DoKludgeLn(TmpStr);
  142.                  End;
  143.             Else
  144.               Begin
  145.               Msg^.DoStringLn(TmpStr);
  146.               End;
  147.             End;
  148.           End
  149.         Else
  150.           Begin
  151.           Msg^.DoStringLn('');
  152.           End;
  153.         TmpStr := TF.GetString;
  154.         End;
  155.       FixSpaces(MsgFrom);
  156.       Msg^.SetFrom(Proper(MsgFrom));
  157.       FixSpaces(MsgTo);
  158.       Msg^.SetTo(Proper(MsgTo));
  159.       FixSpaces(MsgSubj);
  160.       Msg^.SetSubj(MsgSubj);
  161.       Msg^.SetPriv(Priv);
  162.       Msg^.SetDate(DateStr(GetDosDate));
  163.       Msg^.SetTime(TimeStr(GetDosDate));
  164.       Msg^.SetLocal(True);
  165.       Msg^.SetEcho(True);
  166.       Msg^.SetOrig(OrigAddr);
  167.       Msg^.SetDest(DestAddr);
  168.       If Msg^.WriteMsg <> 0 Then
  169.         WriteLn('Error saving message')
  170.       Else
  171.         WriteLn('Message Saved');
  172.       If CloseMsgArea(Msg) Then;
  173.       End
  174.     Else
  175.       WriteLn('Unable to open msg base: ', MsgAreaId);
  176.     If TF.CloseTextFile Then;
  177.     End
  178.   Else
  179.     WriteLn('Unable to open msg text file: ', MsgFileName);
  180.   TF.Done;
  181.   If Del Then
  182.     Begin
  183.     If EraseFile(MsgFileName) Then
  184.       WriteLn(MsgFileName, ' erased');
  185.     End;
  186.   End;
  187.  
  188.  
  189. Begin
  190. If ParamCount = 0 Then
  191.   Begin
  192.   WriteLn('MsgImprt - Imports text into a message base');
  193.   WriteLn;
  194.   WriteLn('MsgImprt TextFileName {optional paramaters}');
  195.   WriteLn('    /FFrom_Name        /TTo_Name            /SSubject_Line');
  196.   WriteLn('    /OOrigAddr         /DDestAddr           /AMsgAreaId');
  197.   WriteLn('    /P = Private       /E = Erase File');
  198.   Halt(1);
  199.   End;
  200. WriteLn('MsgImprt - Message Import Utility');
  201. WriteLn('Copyright 1993 by Mark May - Mythical Kingdom Software');
  202. WriteLn;
  203. InitMsgValues;
  204. ProcessCmdLine;
  205. TxtSearch.Init;
  206. TxtSearch.FFirst(WildName);
  207. While TxtSearch.Found Do
  208.   Begin
  209.   MsgFileName := TxtSearch.GetFullPath;
  210.   ProcessMsgFile;
  211.   TxtSearch.FNext;
  212.   End;
  213. TxtSearch.Done;
  214. End.
  215.