Program MsgImprt;

{$I MKB.DEF}

{ Example program for the MKMsg objects                                }

{ Copyright 1993 by Mark May - Mythical Kingdom Software               }
{ MK Tech BBS 513-237-7737     1:110/290      ->MYTHKING               }
{ P.O. Box 24808, Huber Heights, OH 45424                              }
{ maym@dmapub.dma.org                                                  }


{ You may freely use this code as an example, but should give          }
{ appropriate credit to the author.                                    }

{ Notice that by using OOP and the MKOpen unit, this program will      }
{ require absolutely *no* changes as additional message base types     }
{ are added.                                                           }

{$M 16384,0,655360}

{$A+}     { Word Align Data             }
{$B-}     { Shortcut Boolean Evaluation }
{$E+}     { 8087 Emulation              }  {®N}
{$Y+}     { Symbol Information          }  {®L,D}
{$L+}     { Local Symbol Information    }  {®D} {¯Y}
{$V-}     { No Strict Var-String Check  }
{$N-}     { Do Not Use 8087             }  {¯E}
{$O-}     { Overlays Not Allowed        }
{$F-}     { Force Far Calls Disabled    }
{$X-}     { Extended Syntax Disabled    }
{$P-}     { Open Strings Disabled       }
{$G+}     { 80286 Code Generation       }
{$I+}     { I/O Checking                }
{$S-}     { Stack Checking Disabled     }  {D+}
{$Q-}     { Overflow Checking Disabled  }  {D+}
{$R-}     { Range Checking Disabled     }  {D+}
{$D-}     { Debug Information Disabled  }  {D+} {¯L,Y}
{$T-}     { @ Allways Returns Untyped   }
{$W-}     { Windows Frame Disabled      }

Uses MKFile, MKString, MKMsgAbs, MKOpen, MKGlobT, MKDos, Use32
{$IFDEF WINDOWS}
, MKWCrt;
{$ELSE}
;
{$ENDIF}

Var
  Msg: AbsMsgPtr;                      {Pointer to msg object}
  MsgAreaId: String[128];              {Message Area Id to post msg in}
  MsgFrom: String[50];                 {Author of the message}
  MsgTo: String[50];                   {Who the message is to}
  MsgSubj: String[100];                {Subject of the message}
  OrigAddr: AddrType;                  {Fido-style originating address}
  DestAddr: AddrType;                  {Fido-style destination address}
  MsgFileName: String;                 {File name with message text}
  WildName: String;                    {Search file name given for msg text}
  MsgType: MsgMailType;                {Type of msg to be written}
  Priv: Boolean;                       {Is message private}
  Del: Boolean;                        {Erase msg text file afterwards}
  TxtSearch: FindObj;                  {wildcard processor}
  Orig: String[40];



Procedure InitMsgValues;               {initial message values to defaults}
  Begin
  MsgAreaId := '';
  MsgFrom := 'System';
  MsgTo := '*';
  MsgSubj := '?';
  WildName := 'MsgImprt.Txt';
  MsgType := mmtNormal;
  Priv := False;
  Del := False;
  Orig := '';
  FillChar(OrigAddr, SizeOf(OrigAddr), #0);
  FillChar(DestAddr, SizeOf(DestAddr), #0);
  End;


Procedure FixSpaces(Var St: String);   {change underscores to spaces}
  Var
    i: Word;

  Begin
  For i := 1 to Length(St) Do
    Begin
    If St[i] = '_' Then
      St[i] := ' ';
    End;
  End;


Procedure ProcessCmdLine;              {Process command line params}
  Var
    i: Word;
    TmpStr: String;

  Begin
  For i := 1 to ParamCount Do
    Begin
    TmpStr := ParamStr(i);
    Case TmpStr[1] of
      '-','/':                         {command line param}
        Begin
        Case UpCase(TmpStr[2]) of
          'F': MsgFrom := Copy(TmpStr, 3, 50);
          'S': MsgSubj := Copy(TmpStr, 3, 100);
          'T': MsgTo := Copy(TmpStr, 3, 50);
          'A': MsgAreaId := Copy(TmpStr, 3, 128);
          'P': Priv := True;
          'E': Del := True;
          { ** Add type of mail(net/echo) and echo(+/-) here}
          'O': If not ParseAddr(Copy(TmpStr, 3, 128), DestAddr, OrigAddr) Then
                 fillchar(OrigAddr,sizeof(OrigAddr),0);
          'D': If not ParseAddr(Copy(TmpStr, 3, 128), OrigAddr, DestAddr) Then
                 fillchar(DestAddr,sizeof(DestAddr),0);
          '*': Orig := Copy(TmpStr, 3, 40);
          Else
            WriteLn('Invalid cmd line param: ', TmpStr);
          End;
        End;
      Else
        Begin                          {Msg Text Filename}
        WildName := TmpStr;
        End;
      End;
    End;
  End;


Procedure ProcessMsgFile;              {Process text from message file}
  Var
    TF: TFile;                         {Use TFile object for ease of use}
    TmpStr: String;
    OS,DS: Boolean;
    B: Byte;

  procedure SetAddr(A:AddrType;D:char;F:boolean);

    begin
      if (F or (A.Net<>0) or (A.Node<>0)) and not
         ((D='O') and OS) or ((D='D') and DS) then
        if D='D' then begin
          Msg^.SetDest(A);
          DS:=true;
         end else if D='O' then begin
          Msg^.SetOrig(A);
          OS:=true;
        end;
    end;

  Begin
  TF.Init;
  OS:=false;
  DS:=false;
  If TF.OpenTextFile(MsgFileName) Then
    Begin
    If OpenMsgArea(Msg, MsgAreaId) Then
      Begin
      Msg^.StartNewMsg;
      SetAddr(OrigAddr,'O',false);
      SetAddr(DestAddr,'D',false);
      Msg^.DoKludgeLn(^A+'CHRS: IBMPC 2');
      TmpStr := TF.GetAString;
      While TF.StringFound Do
        Begin
        If Length(TmpStr) > 0 Then
          Begin
          Case TmpStr[1] of
            '%': Begin
                 Case UpCase(TmpStr[2]) Of
                   'F': MsgFrom := Copy(TmpStr, 3, 50);
                   'S': MsgSubj := Copy(TmpStr, 3, 100);
                   'T': MsgTo := Copy(TmpStr, 3, 50);
                   'P': Priv := True;
                   'E': Del := True;
                   'O': If ParseAddr(Copy(TmpStr, 3, 128), OrigAddr, DestAddr) Then
                          SetAddr(OrigAddr,'O',false);
                   'D': If ParseAddr(Copy(TmpStr, 3, 128), DestAddr, OrigAddr) Then
                          SetAddr(DestAddr,'D',false);
                   '*': Orig := Copy(TmpStr, 3, 40);
                   Else
                     Begin
                     Msg^.DoString(TmpStr);
                     End;
                   End;
                 End;
            #1:  Begin
                 Msg^.DoKludgeLn(TmpStr);
                 End;
            Else
              Begin
              if (MsgSubj='?') and (TmpStr<>'') then begin
                MsgSubj:=TmpStr;
                for B:=1 to length(MsgSubj) do
                  if MsgSubj[B] in [#0..#31,#127,#255] then begin
                    MsgSubj:=copy(MsgSubj,1,B-1);
                    break;
                  end;
              end;
              Msg^.DoString(TmpStr);
              End;
            End;
          End
        Else
          Begin
          Msg^.DoStringLn('');
          End;
        TmpStr := TF.GetAString;
        End;
      If Orig<>'' Then
        Begin
        For B := 1 To Length(Orig) Do
          If Orig[B]='_' Then
            Orig[B] := ' ';
        Msg^.DoStringLn('');
        Msg^.DoStringLn('---');
        Msg^.DoStringLn(' * Origin: '+Orig+' ('+AddrStr(OrigAddr)+')');
        End;
      FixSpaces(MsgFrom);
      Msg^.SetFrom(Proper(MsgFrom));
      FixSpaces(MsgTo);
      Msg^.SetTo(Proper(MsgTo));
      FixSpaces(MsgSubj);
      Msg^.SetSubj(MsgSubj);
      Msg^.SetPriv(Priv);
      Msg^.SetDate(DateStr(GetDosDate));
      Msg^.SetTime(TimeStr(GetDosDate));
      Msg^.SetLocal(True);
      Msg^.SetEcho(True);
      SetAddr(OrigAddr,'O',true);
      SetAddr(DestAddr,'D',true);
      If Msg^.WriteMsg <> 0 Then
        WriteLn('Error saving message')
      Else
        WriteLn('Message Saved');
      If CloseMsgArea(Msg) Then;
      End
    Else
      WriteLn('Unable to open msg base: ', MsgAreaId);
    If TF.CloseTextFile Then;
    End
  Else
    WriteLn('Unable to open msg text file: ', MsgFileName);
  TF.Done;
  If Del Then
    Begin
    If EraseFile(MsgFileName) Then
      WriteLn(MsgFileName, ' erased');
    End;
  End;


Begin
If ParamCount = 0 Then
  Begin
  WriteLn('MsgImprt - Imports text into a message base');
  WriteLn;
  WriteLn('MsgImprt TextFileName {optional paramaters}');
  WriteLn('    /FFrom_Name        /TTo_Name            /SSubject_Line');
  WriteLn('    /OOrigAddr         /DDestAddr           /AMsgAreaId');
  WriteLn('    /*Origininline     /P = Private         /E = Erase File');
  Halt(1);
  End;
WriteLn('MsgImprt - Message Import Utility');
WriteLn('Copyright 1993 by Mark May - Mythical Kingdom Software');
WriteLn;
InitMsgValues;
ProcessCmdLine;
TxtSearch.Init;
TxtSearch.FFirst(WildName);
While TxtSearch.Found Do
  Begin
  MsgFileName := TxtSearch.GetFullPath;
  ProcessMsgFile;
  TxtSearch.FNext;
  End;
TxtSearch.Done;
End.