utility.pas

邮件系统的代码

unit Utility;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw,Shellapi, Menus,registry,ComObj,
  KsSkinComboBoxs, IBCustomDataSet, IBQuery,IniFiles, Imm,DataSet;
type
//操作系统
TOSVersion = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K, osME, osXP);
const
  SubKeyPath='\software\MailServer\';

procedure RightTopForm(lForm:Tform);
procedure CenterForm1(lForm:Tform);
procedure MaxForm(lForm:Tform);
function IsValidDir(SearchRec:TSearchRec):Boolean;
function SearchFile(mainpath:string=''; FileExt:string='mskn'):TStrings;
function ShowWindow(InstanceClass: TComponentClass):boolean;
function isRight(Str:string):boolean;
function IsFloat(str:string):boolean;
function IsInteger(str:string):boolean;
function CBselect(inCB:tcombobox;tValue:string;outCB:tcombobox):boolean;overload;
function CBSelect(inCB:TSeSkinComboBox;tValue:string;outCB:TSeSkinComboBox):Boolean;overload;

function rPutValue(tName,tValue:String;tReg:boolean=false):boolean;overload; //写入ini/注册表中当前应用程序某项值
function rGetValue(tName:string;tDefault:String='';tReg:boolean=false):string;overload;//获取ini/注册表中当前应用程序某项值
function rDeleteKey(tName:String;tReg:boolean=false):boolean;overload;  //删除ini/reg中某键值

function rPutValue(tSection,tName,tValue:String):boolean;overload; //写入ini当前应用程序某项值,指定section
function rGetValue(tSection,tName,tDefault:String):string;overload;//获取ini当前应用程序某项值,指定section
function rDeleteKey(tSection,tName:String):boolean;overload;////删除ini/reg中某键值,指定section

procedure URLink(URL:PChar);

function GetOS:TOSVersion;

function getnumber:string;
function CorrectStr(strSource:string;ichar:char=''''):string;
//打开输入法
procedure OpenIME(IMEName: string);
//关闭输入法
procedure CloseIME(IMEName: string);
{-------------------------------END-------------------------------------------}

var
  os:TosVersion;
  osVersion:string;
  Company,LCompany,JCompany:string;
  MailDataSet:TDataSet;
  SDomain:boolean;
implementation

procedure Sort(var A: array of Real);
var
  I, J: Integer;//, T
  T:real;
begin
  for I := High(A) downto Low(A) do
    for J := Low(A) to High(A) - 1 do
      if A[J] > A[J + 1] then
      begin
        T := A[J];
        A[J] := A[J + 1];
        A[J + 1] := T;
      end;
end;

function catsubstr(s:string;space:string;idx:integer):string;
VAR
  I,J:INTEGER;
  ST:STRING;
BEGIN
  ST:=TRIM(S);
  J:=1;
  while (st<>'')and (j<idx) do
  begin
    i:=pos(space,st);
    if i=0 then
      begin
        result:='';
        exit;
      end;
    st:=copy(st,i+length(space),length(st));
    j:=j+1;
  end;
  if j<idx then result:=''
  else
  begin
    i:=pos(space,st);
    if i=0 then
      result:=st
    else
      result:=copy(st,0,i-1);
  end;

END;{of catsubstr}


FUNCTION GetSubStr(S:STRING;IDX:INTEGER):STRING;
var
  previouschar:char;
  index:integer;
  pos,pos1,len1,len:integer;
begin
  previouschar:=#32;
  index:=0;
  pos:=1;
  pos1:=1;
  len:=length(s);
  while pos<=len do
  begin
    if not((s[pos]=#32) or (s[pos]=#9)) then
    begin
      if (previouschar=#32) or (previouschar=#9) then
      begin
        index:=index+1;
        pos1:=pos;
      end;
    end;

    if index=idx then
      break
    else
    begin
      previouschar:=s[pos];
      inc(pos);
    end;
  end;
  if index<>idx then
  begin
    result:='';
  end
  else
  begin
    len1:=1;
    inc(pos);
    while pos<=len do
    begin
      if (s[pos]=#32) or (s[pos]=#9) then
        break
      else
      begin
        inc(len1);
        inc(pos);
      end;
    end;
    result:=copy(s,pos1,len1);
  end;
end;

procedure URLink(URL:PChar);
begin
  ShellExecute(0, nil, URL, nil, nil, SW_MAXIMIZE);
//    if ShellExecute(0, nil, URL, nil, nil, SW_NORMAL) <= 32 then
//    showmessage('Fail');
{在要调用的地方使用
URLink('Readme.txt');
如果是链接主页的话，那么改用
URLink('http://WWW.QIEE.COM');
}
end;


function getnumber:string;
var Hour,Min,Sec,MSec:Word;
  SHour,SMin,SSec,SMSec:string;
begin
  DecodeTime(Now(), Hour, Min, Sec, MSec);
  SHour:=inttostr(Hour);
  SMin:=inttostr(Min);
  sSec:=inttostr(Sec);
  sMsec:=inttostr(MSec);
  if Hour<10 then SHour:='0'+SHour;
  if Min<10 then SMin:='0'+SMin;
  if Sec<10 then Ssec:='0'+Ssec;
  result:=SHour+smin+ssec;
end;

function GetOS:TOSVersion;
var
OS :TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  GetVersionEx(OS);
  Result:=osUnknown;
  if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then begin
  case OS.dwMajorVersion of
  3: Result:=osNT3;
  4: Result:=osNT4;
  5: Result:=os2K;
  end;
  if (OS.dwMajorVersion=5) and (OS.dwMinorVersion=1) then
    Result:=osXP;
  end else begin
  if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then begin
    Result:=os95;
  if (Trim(OS.szCSDVersion)='B') then
    Result:=os95OSR2;
  end else
  if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then begin
    Result:=os98;
  if (Trim(OS.szCSDVersion)='A') then
    Result:=os98SE;
  end else
  if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=90) then
    Result:=osME;
  end;
end;

function rPutValue(tName,tValue:String;tReg:boolean=false):boolean;
var
  Reg: TRegistry;
  SysIni:Tinifile;
  FileName:string;
begin
  if tReg=false then
  begin
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    SysIni.WriteString('System',tName,tValue);
    Result:=true;
  except
    Result:=false;
  end;
  SysIni.Free;
  end
  else
  begin
      Reg := TRegistry.Create;
      if tName='' then
      begin
      result:=false;
      exit;
      end;
      try
        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKey(SubKeyPath, True) then
          Reg.WriteString(uppercase(tName),tValue);
        result:=true;
      finally
        Reg.CloseKey;
        Reg.Free;
      end;
  end;
end;

function rGetValue(tName:string;tDefault:String='';tReg:boolean=false):string;
var
  Reg: TRegistry;
  SysIni:Tinifile;
  FileName:string;
begin
  if tReg=false then
  begin
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    Result:=SysIni.ReadString('System',tName,tDefault);
  except
    Result:=tDefault;
  end;
  if trim(Result)='' then Result:=tDefault;
  SysIni.Free;
  end
  else
  begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKey(SubKeyPath, false) then
           result := Reg.readstring(uppercase(tName));
      finally
        Reg.CloseKey;
        Reg.Free;
        if trim(result) = '' then result:=tDefault;
      end;
  end;
end;

function rDeleteKey(tName:String;tReg:boolean=false):boolean;
var
  Reg: TRegistry;
  SysIni:Tinifile;
  FileName:string;
begin
  if tReg=false then
  begin
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    SysIni.DeleteKey('System',tName);
    Result:=true;
  except
    Result:=false;
  end;
  SysIni.Free;
  end
  else
  begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKey(SubKeyPath, false) then
           result := Reg.DeleteKey(uppercase(tName));
      finally
        Reg.CloseKey;
        Reg.Free;
      end;
  end;
end;

function rDeleteKey(tSection,tName:String):boolean;
var
  SysIni:Tinifile;
  FileName:string;
begin
  if trim(tSection)='' then tSection:='System';
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    SysIni.DeleteKey(tSection,tName);
    Result:=true;
  except
    Result:=false;
  end;
  SysIni.Free;
end;


function rPutValue(tSection,tName,tValue:String):boolean;
var
  SysIni:Tinifile;
  FileName:string;
begin
  if trim(tSection)='' then tSection:='System';
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    SysIni.WriteString(tSection,tName,tValue);
    Result:=true;
  except
    Result:=false;
  end;
  SysIni.Free;
end;

function rGetValue(tSection,tName,tDefault:String):string;
var
  SysIni:Tinifile;
  FileName:string;
begin
  if trim(tSection)='' then tSection:='System';
  FileName:=ExtractFilePath(Paramstr(0))+'SysSetup.ini';
  SysIni:=Tinifile.Create(FileName);
  try
    Result:=SysIni.ReadString(tSection,tName,tDefault);
  except
    Result:=tDefault;
  end;
  if trim(Result)='' then Result:=tDefault;
  SysIni.Free;
end;

function CBselect(inCB:tcombobox;tValue:string;outCB:tcombobox):boolean;
var tmpi:integer;
begin
  result:=false;
  for tmpi:=0 to inCB.Items.Count -1 do
    if incb.Items.Strings[tmpi]=tvalue then
    begin
      incb.ItemIndex:=tmpi;
      outcb.ItemIndex:=tmpi;
      result:=true;
    end;
end;

function CBSelect(inCB:TSeSkinComboBox;tValue:string;outCB:TSeSkinComboBox):Boolean;overload;
var tmpi:integer;
begin
  result:=false;
  for tmpi:=0 to inCB.Items.Count -1 do
    if incb.Items.Strings[tmpi]=tvalue then
    begin
      incb.ItemIndex:=tmpi;
      outcb.ItemIndex:=tmpi;
      result:=true;
    end;
end;


function IsInteger(str:string):boolean;
begin
  result:=false;
  try
    strtoint(str);
  except
    exit;
  end;
  result:=true;
end;

function IsFloat(str:string):boolean;
begin
  result:=false;
  try
    strtofloat(str);
  except
    exit;
  end;
  result:=true;
end;

function isRight(Str:string):boolean;
begin
  result:=false;
  Str:=trim(Str);
  if isfloat(Str) then result:=true;
  if isinteger(Str) then result:=true;
end;

function CorrectStr(strSource:string;ichar:char=''''):string;
var
  I: Integer;
  s, strTemp: string;
begin
if ichar='' then ichar:='''';
  for I := 1 to Length(strSource) do
  begin
    if strSource[i] = ichar then
    begin
    case ichar of
    '''':  strTemp :=  '''''';
    #13: strTemp:= '';
    #10: strTemp:='|';
    '|': strTemp:=#13#10+'';
    else
      strTemp:='|';
    end;
    end
    else
      strTemp := strSource[i];
    s := s + strTemp;
  end;
  result := s;
end;

function ShowWindow(InstanceClass: TComponentClass):boolean;
var lFrm:TForm;
begin
  Application.CreateForm(InstanceClass,lFrm);
  try
    try
      lFrm.ShowModal;
      Result :=true;
    except
      Result :=false;
    end;
  finally
    lFrm.Free;
  end;
end;

function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
if (SearchRec.Attr=16) and
(SearchRec.Name<>'.') and
(SearchRec.Name<>'..') then
Result:=True
else
Result:=False;
end;

function SearchFile(mainpath:string=''; FileExt:string='mskn'):TStrings;
var
  tmplist:TStrings;
  searchRec:TsearchRec;
  tExt:string;
begin
tmplist:=TStringList.Create;
result:=tmplist;
if trim(mainpath)='' then
mainpath :=ExtractFilePath(Application.ExeName)+'skins\';
FileExt:=lowercase(FileExt);
if (FindFirst(mainpath+'*.*', faAnyFile, SearchRec)=0) then
begin
tExt:=lowercase(copy(SearchRec.Name,length(SearchRec.Name)-length(FileExt)+1,length(FileExt)));
if (IsValidDir(SearchRec)=false) and (tExt=FileExt) then
  tmplist.Add(SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
tExt:=lowercase(copy(SearchRec.Name,length(SearchRec.Name)-length(FileExt)+1,length(FileExt)));
if (IsValidDir(SearchRec)=false) and (tExt=FileExt) then
tmplist.Add(SearchRec.Name);
end;
end;
FindClose(SearchRec);
result:=tmplist;
end;

function GetItem(buf:string;var TruncLeft:string;iIndex:integer):string;
var
  index1,index2:integer;
  lBuf:string;
  tmpi:integer;
begin
  lBuf:=buf;
  result := buf;
  for tmpi:=0 to iIndex-1 do
  begin
    index1:=pos('[',lBuf);
    index2:=pos(']',lBuf);
    result:=copy(lbuf,index1+1,index2-index1-1);
    lBuf:=copy(lBuf,index2+1,length(buf));
  end;
  TruncLeft := lBuf;
end;

procedure CenterForm1(lForm:Tform);
begin
  lForm.Top :=(Screen.Height - lForm.Height ) div 2;
  lForm.Left :=(Screen.Width - lForm.Width ) div 2;
end;

procedure MaxForm(lForm:Tform);
begin
   lForm.Width:=Screen.Width;
   lForm.Height:=Screen.Height;
   lForm.Left:=0;
   lForm.Top:=0;
end;

procedure RightTopForm(lForm:Tform);
begin
   lForm.Left := screen.Width - lForm.Width ;
   lForm.Top := 0;
end;

procedure OpenIME(IMEName: string);
var
  iIndex: Integer;
  myHKL:HKL;
begin
  if not SysLocale.FarEast then Exit;
  if trim(IMEName) <> '' then
  begin
    if (AnsiCompareText(IMEName, Screen.DefaultIme) <> 0) and
      (Screen.Imes.Count <> 0) then
    begin
      iIndex := Screen.Imes.IndexOf(IMEName);
      if iIndex >=0 then
      begin
        myHKL := HKL(Screen.Imes.Objects[iIndex]);
        myHKL := ActivateKeyboardLayout(myHKL, KLF_ACTIVATE);
      end;
    end;
  end;
end;

procedure CloseIME(IMEName: string);
var
  myHKL:HKL;
begin
  myHKL := GetKeyboardLayout(0);
  if ImmIsIME(myHKL) then
    ImmSimulateHotKey(Application.Handle,IME_CHotKey_symbol_Toggle);
end;


end.