umain.~pas

由于工作需要

{*******************************************************}
{                                                       }
{       邮件备份代码工具                                }
{                                                       }
{       版权所有 (C) 2008                               }
{                                                       }
{       郑志强 [e-mail]                            }
{*******************************************************}


unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton, ExtCtrls, RzPanel, StdCtrls, Mask, RzEdit,
  OverbyteIcsWndControl, OverbyteIcsSmtpProt, RzCommon;

type
  TFrmMain = class(TForm)
    btn1: TRzButton;
    btn2: TRzButton;
    rzgrpbx1: TRzGroupBox;
    lbl1: TLabel;
    edtSmtpServer: TRzEdit;
    lbl2: TLabel;
    edtSmtpPort: TRzEdit;
    lbl3: TLabel;
    edtSmtpUser: TRzEdit;
    lbl4: TLabel;
    edtSmtpPass: TRzEdit;
    rzgrpbx2: TRzGroupBox;
    lbl5: TLabel;
    edtMailAddr: TRzEdit;
    lbl6: TLabel;
    edtCcMailAddr: TRzEdit;
    lbl7: TLabel;
    edtSmtpName: TRzEdit;
    rzrgnfl1: TRzRegIniFile;
    btn3: TRzButton;
    dlgOpen1: TOpenDialog;
    rzgrpbx3: TRzGroupBox;
    lbl8: TLabel;
    edtTopic: TRzEdit;
    procedure FormCreate(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SendMail(AFileName, AVer: string; ATestMail: Boolean);
    procedure CreateParams(var Params:TCreateParams); override;
  end;

var
  FrmMain: TFrmMain;
  DebugMode: Boolean;

implementation

uses USendStatus;

{$R *.dfm}

function EncryptionEngine(Src: string; Key: string; Encrypt: boolean): string;
var
  //idx: integer;
  KeyLen: integer;
  KeyPos: integer;
  offset: integer;
  Dest: string;
  SrcPos: integer;
  SrcAsc: integer;
  TmpSrcAsc: integer;
  range: integer;

begin
  if Src = '' then
  begin
    Result := '';
    Exit;
  end;
  KeyLen := Length(Key);
  if KeyLen = 0 then
    Key := '11222333';
  KeyPos := 0;
  //SrcPos := 0;
  //SrcAsc := 0;
  range := 256;
  if Encrypt then
  begin
    Randomize;
    offset := random(range);
    Dest := format('%1.2x', [offset]);
    for SrcPos := 1 to Length(Src) do
    begin
      SrcAsc := (Ord(Src[SrcPos]) + offset) mod 255;
      if KeyPos < KeyLen then
        KeyPos := KeyPos + 1
      else
        KeyPos := 1;
      SrcAsc := SrcAsc xor Ord(Key[KeyPos]);
      Dest := Dest + format('%1.2x', [SrcAsc]);
      offset := SrcAsc;
    end;
  end
  else
  begin
    offset := StrToInt('$' + copy(Src, 1, 2));
    SrcPos := 3;
    repeat
      SrcAsc := StrToInt('$' + copy(Src, SrcPos, 2));
      if KeyPos < KeyLen then
        KeyPos := KeyPos + 1
      else
        KeyPos := 1;
      TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
      if TmpSrcAsc <= offset then
        TmpSrcAsc := 255 + TmpSrcAsc - offset
      else
        TmpSrcAsc := TmpSrcAsc - offset;
      Dest := Dest + chr(TmpSrcAsc);
      offset := SrcAsc;
      SrcPos := SrcPos + 2;
    until SrcPos >= Length(Src);
  end;
  Result := Dest;
end;

procedure TFrmMain.btn1Click(Sender: TObject);
begin
  rzrgnfl1.WriteString('Option', 'SmtpServer', edtSmtpServer.Text);
  rzrgnfl1.WriteString('Option', 'SmtpName', edtSmtpName.Text);
  rzrgnfl1.WriteString('Option', 'SmtpPort', edtSmtpPort.Text);
  rzrgnfl1.WriteString('Option', 'SmtpUser', edtSmtpUser.Text);
  rzrgnfl1.WriteString('Option', 'SmtpPass', EncryptionEngine(edtSmtpPass.Text, 'zzqcs123', True));
  rzrgnfl1.WriteString('Option', 'MailAddr', edtMailAddr.Text);
  rzrgnfl1.WriteString('Option', 'CcMailAddr', edtCcMailAddr.Text);
  rzrgnfl1.WriteString('Option', 'TopicCustom', edtTopic.Text);
  ModalResult := mrOk;
end;

procedure TFrmMain.btn2Click(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TFrmMain.btn3Click(Sender: TObject);
begin
  if dlgOpen1.Execute then
  begin
    SendMail(dlgOpen1.FileName, '', True);
  end;
end;

procedure TFrmMain.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    exStyle := exStyle or WS_EX_APPWINDOW;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  rzrgnfl1.Path := ExtractFilePath(Application.ExeName) + 'config.ini';
  edtSmtpServer.Text := rzrgnfl1.ReadString('Option', 'SmtpServer', '');
  edtSmtpName.Text := rzrgnfl1.ReadString('Option', 'SmtpName', '');
  edtSmtpPort.Text := rzrgnfl1.ReadString('Option', 'SmtpPort', '25');
  edtSmtpUser.Text := rzrgnfl1.ReadString('Option', 'SmtpUser', '');
  edtSmtpPass.Text := EncryptionEngine(rzrgnfl1.ReadString('Option', 'SmtpPass', ''), 'zzqcs123', False);
  edtMailAddr.Text := rzrgnfl1.ReadString('Option', 'MailAddr', '');
  edtCcMailAddr.Text := rzrgnfl1.ReadString('Option', 'CcMailAddr', '');
  edtTopic.Text := rzrgnfl1.ReadString('Option', 'TopicCustom', '代码备份：<file>_<ver>_<date>');
  DebugMode := rzrgnfl1.ReadBool('Option', 'Debug', False);
end;

procedure TFrmMain.SendMail(AFileName, AVer: string; ATestMail: Boolean);
var
  Pm: TMailSendQueue;
  sm: TSendMailThread;
  s, s1, sd: string;
  i: Integer;

  function ReplaceString(var S: string; const Token, NewToken: string; bCaseSensitive: Boolean): Boolean;
  var
    I: Integer;
    sFirstPart: string;
  begin
    if bCaseSensitive then
      I := AnsiPos(Token, S)
    else
      I := AnsiPos(AnsiUpperCase(Token), AnsiUpperCase(S));

    if I <> 0 then
    begin
      sFirstPart := Copy(S, 1, I - 1) + NewToken;
      S := Copy(S, I + Length(Token), Maxint);
    end;

    Result := I <> 0;
    if Result then
    begin
      ReplaceString(S, Token, NewToken, bCaseSensitive);
      S := sFirstPart + S;
    end;
  end;

begin
  s := ExtractFileName(AFileName);
  Delete(s, Length(s) - length(ExtractFileExt(AFileName)) + 1, length(ExtractFileExt(AFileName)) + 1);
  i := 1;
  sd := '';
  while i <= Length(s) do
  begin
    if s[i] = '_' then
    begin
      if (i + 1 <= Length(s)) and (s[i + 1] in ['0'..'9']) then
      begin
        Break;
      end;
    end;
    Inc(i);
  end;
  if i <> Length(s) then
  begin
    sd := Copy(s, i + 1, Length(s) - i);
    Delete(s, i, Length(s) - i + 1);
  end;
  s1 := edtTopic.Text;
  ReplaceString(s1, '<file>', s, False);
  ReplaceString(s1, '<ver>', AVer, False);
  ReplaceString(s1, '<date>', sd, False);
  Pm.Topic := s1;
  Pm.Content := '自动备份代码文件：' + AFileName + #13#10 + '版本：' + AVer + #13#10 + '备份时间：' +
    DateTimeToStr(Now);
  Pm.MailAddr := edtMailAddr.Text;
  Pm.CCMailAddr := edtCcMailAddr.Text;
  pm.AttachFiles := AFileName;
  Pm.SmtpMailName := edtSmtpName.Text;
  Pm.SmtpServer := edtSmtpServer.Text;
  Pm.SmtpPort := edtSmtpPort.Text;
  pm.SmtpUser := edtSmtpUser.Text;
  Pm.SmtpPass := edtSmtpPass.Text;
  Pm.TestMail := ATestMail;
  FrmSendStatus := TFrmSendStatus.Create(Self);
  sm := TSendMailThread.Create(Pm);
  sm.Resume;
  FrmSendStatus.ShowModal;
end;

end.