mailrob1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.ProcessMsg;
var
    Line     : String;
    I        : Integer;
    EMail    : String;
    p        : PChar;
    MsgCount : Integer;
    OkCount  : Integer;
begin
    DisplayMemo.Lines.Add('Clear list');
    ClearNames;

    DisplayMemo.Lines.Add('Reading EMail');
    MsgCount := 0;
    OkCount  := 0;
    while not MbxHandler.Eof do begin
        Inc(MsgCount);
        FMsgLines.LoadFromStream(MbxHandler.MsgStream);
        I := SearchHeader('SUBJECT');
        if I < 0 then
            DisplayMemo.Lines.Add('Subject not found')
        else begin
            Line := FMsgLines.Strings[I];

            if Copy(Line, 10, 9) = 'SUBSCRIBE' then begin
                I := Length(Line);
                while (I > 0) and (Line[I] <> ' ') do
                    Dec(I);
                EMail := Copy(Line, I + 1, 255);
                GetMem(p, Length(EMail) + 1);
                Move(EMail[1], p^, Length(EMail));
                FNames.Add(p);
                Inc(OkCount);
            end;
        end;
        MbxHandler.Next;
        InfoLabel.Caption := Format('%d/%d/%d', [MsgCount, OkCount, MbxHandler.MsgCount]);
        Application.ProcessMessages;
    end;

{$IFNDEF VER80}  { Delphi 1 does'nt support sorting TList items }
    DisplayMemo.Lines.Add('Sort list');
    FNames.Sort(StringCompare);
{$ENDIF}

    DisplayMemo.Lines.Add('Remove duplicates');
    Line := '';
    p    := @Line[1];
    I    := 0;
    while I < FNames.Count do begin
        if StringCompare(p, FNames.Items[I]) = 0 then begin
            FreeMem(FNames.Items[I], StrLen(PChar(FNames.Items[I])) + 1);
            FNames.Delete(I);
        end
        else begin
            p := FNames.Items[I];
            Inc(I);
        end;
    end;

    DisplayMemo.Lines.Add('Display list');
    for I := 0 to FNames.Count - 1 do
        DisplayMemo.Lines.Add(StrPas(PChar(FNames.Items[I])));

    DisplayMemo.Lines.Add('Total : ' + IntToStr(FNames.Count));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SendButtonClick(Sender: TObject);
var
    EMail    : String;
    I        : Integer;
    OkCount  : Integer;
    BadCount : Integer;
    Success  : Boolean;
begin
    if FRunning then begin
        FRunning := FALSE;
        Exit;
    end;
    FRunning := TRUE;
    DisplayMemo.Lines.Add('Sending EMails');
    if FNames.Count <= 0 then begin
        Application.MessageBox('List is empty', 'Warning', MB_OK);
        Exit;
    end;

    OkCount  := 0;
    BadCount := 0;
    try
        SmtpClient.SignOn          := SignOnEdit.Text;
        SmtpClient.Host            := HostEdit.Text;
        SmtpClient.Port            := PortEdit.Text;
        Success := SmtpClient.OpenSync;
        if not Success then
            Exit;
        I := 0;
        while (not Application.Terminated) and (I < FNames.Count) do begin
            if not FRunning then begin
                Log('Canceled');
                CommitLog;
                DisplayMemo.Lines.Add('Canceled');
                Exit;
            end;
            EMail := StrPas(PChar(FNames.Items[I]));
            DisplayMemo.Lines.Add('Sending to ' + EMail);
            Log('Sending to ' + EMail);
            Success := FALSE;
            try
                SmtpClient.RcptName.Clear;
                SmtpClient.RcptName.Add(EMail);
                SmtpClient.HdrFrom         := FromEdit.Text;
                SmtpClient.HdrTo           := EMail;
                SmtpClient.HdrSubject      := SubjectEdit.Text;
                SmtpClient.FromName        := FromEdit.Text;
                SmtpClient.EmailFiles      := nil;
                Success                    := SmtpClient.MailSync;
            except
                on E:Exception do Log(E.Message);
            end;
            if Success then
                Inc(OkCount)
            else begin
                Inc(BadCount);
                Log('Can''t send to ' + EMail);
                DisplayMemo.Lines.Add('Can''t send to ' + EMail);
                { We failed, so disconnect before continuing }
                try
                    SmtpClient.Quit;
                except
                    on E:Exception do Log(E.Message);
                end;
                try
                    SmtpClient.Abort;
                except
                end;
                SmtpClient.SignOn          := SignOnEdit.Text;
                SmtpClient.Host            := HostEdit.Text;
                SmtpClient.Port            := PortEdit.Text;
                Success := SmtpClient.OpenSync;
                if not Success then
                    Exit;
            end;
            CommitLog;
            Inc(I);
            InfoLabel.Caption := Format('%d/%d/%d', [OkCount, BadCount, FNames.Count]);
        end;
    finally
        try
            SmtpClient.Quit;
        except
            on E:Exception do Log(E.Message);
        end;
        DisplayMemo.Lines.Add(IntToStr(OkCount) + ' emails sent succesfully');
        DisplayMemo.Lines.Add(IntToStr(BadCount) + ' failed');
        Log(IntToStr(OkCount) + ' emails sent succesfully');
        Log(IntToStr(BadCount) + ' failed');
        CloseLog;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SmtpClientGetData(Sender: TObject; LineNum: Integer;
  MsgLine: PChar; MaxLen: Integer; var More: Boolean);
var
    Len : Integer;
begin
    if LineNum > EMailMemo.Lines.count then
        More := FALSE
    else begin
        Len := Length(EMailMemo.Lines[LineNum - 1]);
        { Truncate the line if too long (should wrap to next line) }
        if Len >= MaxLen then
            StrPCopy(MsgLine, Copy(EMailMemo.Lines[LineNum - 1], 1, MaxLen - 1))
        else
            StrPCopy(MsgLine, EMailMemo.Lines[LineNum - 1]);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SaveToListButtonClick(Sender: TObject);
var
    Stream : TStream;
    I      : Integer;
begin
    DisplayMemo.Lines.Add('Saving to file');
    if FNames.Count <= 0 then begin
        Application.MessageBox('List is empty', 'Warning', MB_OK);
        Exit;
    end;

    Stream := TFileStream.Create(LstFileEdit.Text, fmCreate);
    try
        for I := 0 to FNames.Count - 1 do begin
            Stream.WriteBuffer(PChar(FNames.Items[I])^, StrLen(PChar(FNames.Items[I])));
            Stream.WriteBuffer(CrLf, 2);
        end;
        DisplayMemo.Lines.Add(IntToStr(FNames.Count) + ' EMails saved');
    finally
        Stream.Destroy;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.LoadFromListButtonClick(Sender: TObject);
var
    Stream   : TMemoryStream;
    I, J     : Integer;
    p, q     : PChar;
    Table    : TTable;
    Field    : TField;
begin
    DisplayMemo.Lines.Add('Loading from file');
    ClearNames;
    if UpperCase(ExtractFileExt(LstFileEdit.Text)) = '.DBF' then begin
        Table := TTable.Create(Self);
        try
            Table.DatabaseName := ExtractFilePath(LstFileEdit.Text);
            Table.TableName := ExtractFileName(LstFileEdit.Text);
            Table.Open;
            Field := Table.FieldByName('EMail');
            while not Table.Eof do begin
                GetMem(q, Length(Field.AsString) + 1);
                StrPCopy(q, Field.AsString);
                FNames.Add(q);
                if DisplayMemo.Lines.Count > 200 then
                    DisplayMemo.Clear;
                DisplayMemo.Lines.Add(StrPas(q));
                Table.Next;
            end;
        finally
            Table.Destroy;
        end;
    end
    else begin
        Stream := TMemoryStream.Create;
        Stream.LoadFromFile(LstFileEdit.Text);
        p := Stream.Memory;
        I := 0;
        while I < Stream.Size do begin
            J := I;
            while (I < Stream.Size) and (p[i] <> #13) do
                Inc(I);
            if p[I] = #13 then
                Dec(I);
            GetMem(q, I - J + 2);
            Move(p[J], q^, I - J + 1);
            q[I - J + 1] := #0;
            FNames.Add(q);
            if DisplayMemo.Lines.Count > 200 then
                DisplayMemo.Clear;
            DisplayMemo.Lines.Add(StrPas(q));
            I := I + 3;
        end;
        Stream.Destroy;
    end;
    DisplayMemo.Lines.Add(IntToStr(FNames.Count) + ' EMails loaded');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SmtpClientCommand(Sender: TObject; Msg: String);
begin
    { Memo boxes are not unlimited...}
    if DisplayMemo.Lines.Count > 200 then
        DisplayMemo.Clear;
    DisplayMemo.Lines.Add('    ' + Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SmtpClientResponse(Sender: TObject; Msg: String);
begin
    { Memo boxes are not unlimited...}
    if DisplayMemo.Lines.Count > 200 then
        DisplayMemo.Clear;
    DisplayMemo.Lines.Add('    ' + Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.MsgFileLoadButtonClick(Sender: TObject);
begin
    LoadEMailMessage(MsgFileEdit.Text);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.SaveMsgFileButtonClick(Sender: TObject);
begin
    SaveEMailMessage(MsgFileEdit.Text);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.MbxFileEditDblClick(Sender: TObject);
begin
    OpenDialog1.DefaultExt := '.mbx';
    OpenDialog1.Filter     := 'Mail files (*.mbx)|*.MBX|All files (*.*)|*.*';
    OpenDialog1.Options    := [ofFileMustExist];
    OpenDialog1.Title      := 'MailRob - Open MBX file';
    OpenDialog1.InitialDir := ExtractFilePath(MbxFileEdit.Text);
    if OpenDialog1.Execute then
         MbxFileEdit.Text := OpenDialog1.FileName;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.MsgFileEditDblClick(Sender: TObject);
begin
    OpenDialog1.DefaultExt := '.txt';
    OpenDialog1.Filter     := 'Message files (*.txt)|*.TXT|All files (*.*)|*.*';
    OpenDialog1.Options    := [ofFileMustExist];
    OpenDialog1.Title      := 'MailRob - Open message file';
    OpenDialog1.InitialDir := ExtractFilePath(MsgFileEdit.Text);
    if OpenDialog1.Execute then
         MsgFileEdit.Text := OpenDialog1.FileName;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMailRobForm.LstFileEditDblClick(Sender: TObject);
begin
    OpenDialog1.DefaultExt := '.txt';
    OpenDialog1.Filter     := 'AMail list files (*.txt)|*.TXT|All files (*.*)|*.*';
    OpenDialog1.Options    := [ofFileMustExist];
    OpenDialog1.Title      := 'MailRob - Open email list file';
    OpenDialog1.InitialDir := ExtractFilePath(LstFileEdit.Text);
    if OpenDialog1.Execute then
         LstFileEdit.Text := OpenDialog1.FileName;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.