unit1.pas

電子報軟體. 你想輕輕鬆鬆的寄送電子報 功能介紹: 1. 支援多個伺服器分散流量. (已可設定每次的最大郵件數) 2. 支援多個設定檔選擇. 3. 可直接選擇硬碟內的 HTML, 純文字檔當做

    procedure DateTimePicker1Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure ListView1Edited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure ListView1Insert(Sender: TObject; Item: TListItem);
    procedure ListView1Deletion(Sender: TObject; Item: TListItem);
    procedure ListView3Deletion(Sender: TObject; Item: TListItem);
    procedure ListView3Edited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure ListView3Insert(Sender: TObject; Item: TListItem);
    procedure CheckBox2Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure Edit5KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox4KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox3KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn7Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Edit11KeyPress(Sender: TObject; var Key: Char);
    procedure Timer2Timer(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure RadioButton8Click(Sender: TObject);
    procedure RadioButton7Click(Sender: TObject);
    procedure RadioButton6Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure Edit12Change(Sender: TObject);
    procedure Edit15Change(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure Edit16Change(Sender: TObject);
    procedure Edit16Click(Sender: TObject);
    procedure Edit10Change(Sender: TObject);
    procedure Edit11Change(Sender: TObject);
    procedure Edit13Change(Sender: TObject);
    procedure Edit14Change(Sender: TObject);
    procedure Label25Click(Sender: TObject);
    procedure Edit21Change(Sender: TObject);
    procedure Edit21KeyPress(Sender: TObject; var Key: Char);
    procedure Edit17Change(Sender: TObject);
    procedure Edit18Change(Sender: TObject);
    procedure CheckBox7Click(Sender: TObject);
    procedure CheckBox8Click(Sender: TObject);
    procedure CheckBox9Click(Sender: TObject);
    procedure Edit20Change(Sender: TObject);
    procedure RadioButton9Click(Sender: TObject);
    procedure RadioButton10Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure Edit20DblClick(Sender: TObject);
    procedure Edit17DblClick(Sender: TObject);
    procedure Edit18DblClick(Sender: TObject);
    procedure Edit19DblClick(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure Label26Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure U1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure Edit22KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn10Click(Sender: TObject);
    procedure BitBtn11Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
      IsMailing : boolean;
      IsPoping : boolean;
      MailThread : TMailGenius;
      POPThread : TPOPGenius;
  end;

var
  Form1: TForm1;
  ConfigFile, ListFile, CurDir, DocumentDir : string;
  IsModified, IsModified2, IsModified3 : boolean;
  KeepMailing : boolean;
  ConnectOK,  CommandMode, retbool : boolean;
  GroupBoxAction : integer;
  WAITHANDLE : THANDLE;
  WAITRETCODE : DWORD;
  SendMsg2 : TIdMessage;
  Msg : TIdMessage;
  Button2Action : string;  
  CS : TRTLCriticalSection;

implementation

uses Unit2;

type EIdResponseError = class(Exception);
type EIdSocketError = class(Exception);


{$R *.DFM}

procedure SaveLog(inlog : string);
var
    myfile : TEXTFILE;
begin
//EnterCriticalSection(CS);
try
if Fileexists(CurDir + 'log.log') then
begin
    AssignFile(myfile,CurDir + 'log.log');
    Append(myfile);
    writeln(myfile,inlog);
    closefile(myfile);
end
else
begin
    AssignFile(myfile,CurDir + 'log.log');
    rewrite(myfile);
    writeln(myfile,inlog);
    closefile(myfile);
end;
except
end;
//LeaveCriticalSection(CS);
end;


function IsChinese(inStr : string):boolean;
var i : integer;
begin
    IsChinese := false;
    for i := 1 to length(inStr) do
    begin
        if ((Ord(inStr[i]) > 127) or (Ord(inStr[i]) < 0)) then
        begin
            IsChinese := true;
            exit;
        end;
    end;
end;

function IsEmailAddress(inStr : string):boolean;
var
    P1,P2 : integer;
    tmpstr : string;
begin
    IsEmailAddress := true;
    if pos(' ',inStr)<>0 then
    begin
        IsEmailAddress := false;
        exit;
    end;
    P1 := pos('@',inStr);
    if P1=0 then
    begin
        IsEmailAddress := false;
        exit;
    end
    else
    begin
        tmpstr := copy(inStr,P1+2,length(inStr)-P1-1);
        if pos('.',tmpstr)=0 then
        begin
            IsEmailAddress := false;
            exit;
        end
        else
        begin
            if Copy(inStr,length(instr),1)='.' then
            begin
                IsEmailAddress := false;
                exit;
            end;
        end;
    end;
end;

function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = true) : string;
var
   iPos: Integer;
begin
     if ADelim = #0 then begin
        // AnsiPos does not work with #0
        iPos := Pos(ADelim, AInput);
     end else begin
         iPos := AnsiPos(ADelim, AInput);
     end;

     if iPos = 0 then begin
        Result := AInput;
        if ADelete then begin
           AInput := '';
        end;
     end else begin
         result := Copy(AInput, 1, iPos - 1);
         if ADelete then begin
            Delete(AInput, 1, iPos + Length(ADelim) - 1);
         end;
     end;
end;

procedure TMailGenius.EnableMail;
begin
    form1.Mail.Enabled := true;
    form1.T1.Enabled := false;
end;

procedure TMailGenius.DisableMail;
begin
    form1.Mail.Enabled := false;
    form1.T1.Enabled := true;
end;

{procedure TMailGenius.InsertLog;
var
    ListItem : TListItem;
begin
        if (form1.ListView2.Items.Count >= strtoint(form1.Edit8.text)) then
        begin
            form1.ListView2.Items.Delete(form1.ListView2.Items.Count-1);
        end;
        ListItem := form1.ListView2.Items.Insert(0);
        ListItem.caption := Msg;
        ListItem.SubItems.Add(datetimetostr(now));
        SaveLog(Msg + ' (' + datetimetostr(now) + ')');
end;}

procedure EnableMail;
begin
    form1.Mail.Enabled := true;
    form1.T1.Enabled := false;
end;

procedure DisableMail;
begin
    form1.Mail.Enabled := false;
    form1.T1.Enabled := true;
end;

procedure TMailGenius.SendGroupMail;
var
    ServerAllDead : boolean;
    SendMsg : TIdMessage;
    BODY, BODY0, IMGLIST, EMBEDLIST, BGLIST : TStringList;
    i, mailcount, ServerCount, RetryCount, retint : integer;
    ListItem : TListItem;
    MyFile : TEXTFILE;
    Msg_Text : TIdText;
    Msg_File : TIdAttachment;
    P1, P2 : integer;
    OriString,tmpString, mydata, TYEAR, TMONTH, TDAY, subjectstr : string;
begin
//Screen.Cursor := crHourglass;
Synchronize(DisableMail);
form1.IsMailing := true;
if FileExists(form1.Edit4.text) then
begin
    ServerAllDead := false;
    KeepMailing := true;
    ConnectOK := false;
    BODY := TStringList.Create;
    BODY0 := TStringList.Create;
    BODY.LoadFromFile(form1.edit4.text);
    SendMsg := TIdMessage.Create(form1);
    DocumentDir := ExtractFilePath(form1.edit4.text);
    SendMsg.Date := now;
    SendMsg.MsgId := 'ePaperBoy.John-Long-Studio.2000';
    SendMsg.ExtraHeaders.Values['Content-ID'] := SendMsg.MsgId;

    if (trim(form1.edit3.text)='') then
    begin
        if (form1.ListView2.Items.Count >= strtoint(form1.Edit8.text)) then
        begin
            form1.ListView2.Items.Delete(form1.ListView2.Items.Count-1);
        end;
        ListItem := form1.ListView2.Items.Insert(0);
        ListItem.caption := '[牡