www.pudn.com > MailServer.rar > 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 (jidx 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.