Email服务器

开发平台：
Delphi

uCommon.pas：源码内容
							unit uCommon;
interface
uses
  Classes,SysUtils,Forms,Dialogs,Windows,ComObj,ActiveX,SHDocVw,Messages,SyncObjs;
  
//{$DEFINE DEBUG}
const
  Decimals=['0'..'9'];
  IdentifyChar=['0'..'9','a'..'z','A'..'Z','_'];
  WM_PREVINSTRUN    = WM_USER + 522;
  WM_SHOW_TIP_FORM  = WM_USER + 523;
  INST_NAME='EMail V1.0.0 By Wp';
  APP_XML='EmailServers.xml';
  PATH_APP='{APP}';
  PATH_SYS='{SYS}';
  PATH_TEMP='{TEMP}';
  
type
  PPop3LoginInfo=^TPop3LoginInfo;
  TPop3LoginInfo=record
    FPopServer,
    FUserName,
    FPwd:string[225];
    FPort:Integer; //added by wp 2009-03-05
  end;
  PPopInfo=^TPopInfo;
  TPopInfo=record
    EMailAddr:string[255];
    pwd:string[16];
    saveto:string[255];
    pop3Server:string[255];
  end;
  PContactAddress=^TContactAddress;
  TContactAddress=record
    Email:string[255];
    displayname:string[20];
  end;
  TEMailAddress=class
    class  function IsEmail(addr:string):Boolean;
    class  function EmailSever(addr:string):string;
    class  function SMTPEmailSever(addr:string):string;
    class  function POP3EmailSever(addr:string):string;
  end;
  //全局函数
  function AppPath:string;
  function SysPath:string;
  function TempPath:string;
  function GetFullPath(path:string):string;
  procedure WriteLog(msg:string);
  procedure Split(spliter,SrcStr:string;List:TStrings;CaseinSense:Boolean=False);
  function Join(spliter:string;List:TStrings):string;
  function PartStr(AStr:string;ASpliter:string;Behind:Boolean=false):string;
  function GenalFileName:string;
  procedure SetHtml(const WebBrowser:TWebBrowser; const Html: string);
  procedure MsgBoxWarn(Msg:string);
  procedure MsgBoxError(Msg:string);
  function MsgBoxYesOrNo(Msg:string):Integer;
  
  function StrBeginWith(StrBegin,Str:string):Boolean;
  function StrEndWith(StrEnd,Str:string):Boolean;
  function MeasureFileSize(Path:string):Int64;
  function FileSizeInKB(Path:string):string;
  function SysTempDir:string;
implementation
{$IFDEF DEBUG}
var
  CS:TCriticalSection;
{$Endif}
 //============================全局函数======================================
function AppPath:string;
begin
  Result:=IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
end;
procedure WriteLog(msg:string);
{$IFDEF DEBUG}
 var
  f:TextFile;
{$ENDIF}
begin
  {$IFDEF DEBUG}
  CS.Acquire;
  try
    AssignFile(f,AppPath+'log.txt');
    if FileExists(AppPath+'log.txt') then
      Append(f)
    else
      Rewrite(f);
    Writeln(f,msg);
    Flush(f);
    CloseFile(f);
  finally
    CS.Release;
  end;
  {$ENDIF}
end;
function SysPath:string;
var
  buf:array[0..MAX_PATH]of AnsiChar;
begin
  FillChar(buf[0],MAX_PATH+1,0);
  GetSystemDirectory(@buf[0],MAX_PATH+1);
  Result:=StrPas(buf);
  Result:=IncludeTrailingPathDelimiter(Result) ;
end;
function TempPath:string;
var
  buf:array[0..MAX_PATH]of AnsiChar;
begin
  FillChar(buf[0],MAX_PATH+1,0);
  GetTempPath(MAX_PATH+1,@buf[0]);
  Result:=StrPas(buf);
  Result:=IncludeTrailingPathDelimiter(Result) ;
end;
function GetFullPath(path:string):string;
begin
  path:= StringReplace(path,PATH_APP,AppPath,[rfReplaceAll, rfIgnoreCase]);
  path:=StringReplace(path,PATH_SYS,SysPath,[ rfReplaceAll,rfIgnoreCase]);
  Result:=StringReplace(path,PATH_TEMP,TempPath,[ rfReplaceAll,rfIgnoreCase]);
end;
procedure Split(spliter,SrcStr:string;List:TStrings;CaseinSense:Boolean=False);
var
  PSrc,PSrcTemp,PSpliter:PAnsiChar;
  I:Integer;
  Dest:string;
begin
  if CaseinSense then
  begin
    SrcStr:=UpperCase(SrcStr);
    spliter:=UpperCase(spliter);
  end;
  
  I:=0;
  PSrcTemp:=PChar(SrcStr);
  PSrc:=PChar(SrcStr);
  PSpliter:=PChar(spliter);
  repeat
    while (StrLComp(PSrcTemp,PSpliter,StrLen(PSpliter))<>0)and (StrLen(PSrcTemp)>=StrLen(PSpliter)) do
    begin
      PSrcTemp:=PSrcTemp+1;
      Inc(I);
    end;
    
    if I<>0 then
    begin
      SetString(Dest,PSrc,I);
      List.Add(Dest);
    end;
    if StrLen(PSrcTemp)<StrLen(PSpliter) then
        Exit
    else
      PSrc:=PSrcTemp+StrLen(PSpliter);
  
    PSrcTemp:=PSrc;
    I:=0;
  until(StrLen(PSrcTemp)<StrLen(PSpliter));
  if (StrLen(PSrc)<>0) and (I<>0)then
  begin
      SetString(Dest,PSrc,I);
      List.Add(Dest);
  end;
end;
function Join(spliter:string;List:TStrings):string;
var
  I:integer;
begin
  Result:='';
  for I:=0  to List.Count-1 do
    Result:=Result +List[I]+spliter;
end;
function PartStr(AStr:string;ASpliter:string;Behind:Boolean=false):string;
var
  post:Integer;
begin
  post:=Pos(ASpliter,AStr);
  if post=0 then
    Result:=AStr
  else
  begin
    if Behind then
      Result:=Copy(AStr,Post+length(ASpliter),MAXWORD)
    else
      Result:= Copy(AStr,0,Post-1)
  end;
end;
function GenalFileName:string;
var
  TmpGUID: TGUID;
begin
  Result:='';
  if CoCreateGUID(TmpGUID) = S_OK then
    Result := GUIDToString(TmpGUID)
  else
    Result:=FormatDateTime('yy-mm-dd-hh-nn-ss',now)
end;
procedure SetHtml(const WebBrowser:TWebBrowser; const Html: string);
var
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
  if not Assigned(WebBrowser.Document) then  WebBrowser.Navigate('about:blank');
  
  hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1);
  {$WARNINGS OFF}
  if 0 = hHTMLText then RaiseLastWin32Error;
  {$WARNINGS ON}
  CopyMemory(Pointer(hHTMLText),
  PChar(Html), Length(Html));
  OleCheck(CreateStreamOnHGlobal
  (hHTMLText, True, Stream));
  try
    OleCheck(WebBrowser.Document.
    QueryInterface(IPersistStreamInit, psi));
    try
      OleCheck(psi.InitNew);
      OleCheck(psi.Load(Stream));
    finally
      psi := nil;
    end;
  finally
    Stream := nil;
  end;
end;
procedure MsgBoxWarn(Msg:string);
var
  P:TPoint;
begin
  GetCursorPos(P);
  Dialogs.MessageDlgPos(msg,mtWarning,[mbYes],0,P.X,P.Y);
end;
procedure MsgBoxError(Msg:string);
var
  P:TPoint;
begin
  GetCursorPos(P);
  Dialogs.MessageDlgPos(msg,mtError,[mbYes],0,P.X,P.Y);
end;
function MsgBoxYesOrNo(Msg:string):Integer;
var
  P:TPoint;
begin
  GetCursorPos(P);
  Result:=Dialogs.MessageDlgPos(msg,mtInformation,mbOKCancel,0,P.X,P.Y);
end;
function StrBeginWith(StrBegin,Str:string):Boolean;
var
  I:Integer;
begin
  Result:=False ;
  if Length(StrBegin)<=Length(Str) then
  begin
    Result:=True;
    for I:=1 to Length(StrBegin) do
    begin
      if StrBegin[I]<>Str[I] then
      begin
        Result:=False;
        Break;
      end;
    end;
  end;
end;
function StrEndWith(StrEnd,Str:string):Boolean;
var
  I:Integer;
begin
  Result:=False ;
  if Length(StrEnd)<=Length(Str) then
  begin
    Result:=True;
    for I:=1 to Length(StrEnd) do
    begin
      if StrEnd[I]<>Str[Length(Str)-Length(StrEnd)+I] then
      begin
        Result:=False;
        Break;
      end;
    end;
  end;
end;
function MeasureFileSize(Path:string):Int64;
var
  f:file of Byte;
begin
  try
    AssignFile(f,Path);
    try
      Reset(f);
      Result:=FileSize(f);
    finally
      CloseFile(f);
    end;
  except
    Result:=0;
  end;
end;
function FileSizeInKB(Path:string):string;
begin
  Result:=IntToStr(MeasureFileSize(path)div 1024)+'KB';
end;
function SysTempDir:string;
var
  arr: array[0..MAX_PATH] of Char;
begin
  FillChar(arr[0],MAX_PATH+1,0);
  if GetTempPath(MAX_PATH, arr)=0 then raise Exception.Create('无法获取系统临时文件夹路径');
  Result:=StrPas(arr);
end;
//==============================================================================
{ TEMailAddress }
class function TEMailAddress.EmailSever(addr: string): string;
var
  postion:Integer;
begin
  Result:='';
  if not IsEmail(addr) then Exit;
  postion:=Pos('@',addr);
  Result:=Copy(addr,postion+1,MAX_PATH);
end;
class function TEMailAddress.IsEmail(addr: string): Boolean;
var
  I,postion:Integer;
  part:string;
begin
  postion:=Pos('@',addr) ;
  part:=Copy(addr,postion+1,MAX_PATH);
  Result:=(postion>1) {and (not(addr[1] in Decimals))} and  (Length(part)>0);
  if Result=False then Exit;
  for I:=1 to postion-1 do
    if not (addr[I] in IdentifyChar) then
    begin
      Result:=False;
      Exit;
    end;
  postion:=Pos('.',part);
  if (postion=0) or (postion=1) or (postion=Length(part)) then
  begin
    Result:=False;
    Exit;
  end;
  for I:=1 to Length(part)  do
  begin
    if I=postion then Continue;
    if not (part[I] in IdentifyChar) then
    begin
      Result:=False;
      Exit;
    end;
  end;
end;
class function TEMailAddress.POP3EmailSever(addr: string): string;
begin
  Result:='pop3.'+EmailSever(addr);
end;
class function TEMailAddress.SMTPEmailSever(addr: string): string;
begin
  Result:='smtp.'+EmailSever(addr);
end;
{$IFDEF DEBUG}
initialization
  CS:=TCriticalSection.Create;
finalization
  CS.free;
{$Endif}
end.

						