?? mailrob1.pas
字號:
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);
StrCopy(q, PChar(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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -