{}
{                                                                          }
{      ҶǳԱ ûбҪظһЩĵ ҵЩܸҴ } 
{      ûһ ע WWW.cdsunco.com/www.ccemove.com  QQ:35013354   }
{                             ϵͳú                            }
{                                                                          }
{}
{ ƣ                                                   }
{ Ԫƣ  ʱⵥԪ                                           }
{ Ԫ汾  V1.0                                                         }
{     ע  õԪĻ                                 }
{ ƽ̨  PWin98SE + Delphi 6.0                                        }
{ ݲԣ  PWin9X/2000/XP + Delphi  6.0                                 }
{     õԪеַϱػʽ                         }
{ ¼¼  2002.07.03 V2.0                                              }
{                 Ԫ汾                                     }
{             2002.03.17 V0.02                                             }
{                 ֺ޸                                 }
{             2002.01.30 V0.01                                             }
{                 Ԫ                                     }
{}
{       :  չַ                                          }
{       :  չʱ                                        }
{       :  չλ                                              }
{       :  չļĿ¼                                      }
{       :  չĶԻ                                              }
{       :  ϵͳܺ                                                  }
{       :  Ӳܺ                                                  }
{       :  繦ܺ                                                  }
{       :  ƴ                                            }
{       :  ݿ⹦ܺ                                                }
{       :  ƹܺ                                                  }
{       :  ܺ                                                  }
{}

unit Communal;
{* |<PRE>
|</PRE>}

interface

{$I CnPack.inc}


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FileCtrl, ShellAPI, CommDlg, MMSystem, WinSock, IniFiles, DBTables, BDE,
  StdCtrls, ComObj, ADODB, Imm, DbCtrls, Db, Registry;

const

  // Ϣ
{$IFDEF GB2312}
  SCnInformation = 'ʾ';
  SCnWarning = '';
  SCnError = '';
{$ELSE}
  SCnInformation = 'Information';
  SCnWarning = 'Warning';
  SCnError = 'Error';
{$ENDIF}

  C1=52845; //ַ㷨Ĺ
  C2=22719; //ַ㷨Ĺ

resourcestring

{$IFDEF GB2312}
  SUnknowError = 'δ֪';
  SErrorCode = '룺';
{$ELSE}
  SUnknowError = 'Unknow error';
  SErrorCode = 'Error code:';
{$ENDIF}

type
   EDBUpdateErr = class(Exception);//޸ıṹʱĴ



//============================================================//
//================ չַ  ===================//
//============================================================//

//ļзAdoִ
function GetConnectionString(DataBaseName:string):string;
//طĻ.
function GetRemoteServerName:string;

function InStr(const sShort: string; const sLong: string): Boolean;     {ͨ}
{* жs1Ƿs2}

function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;  {ͨ}
{* չתַ  Example:   IntToStrEx(1,5,'0');   أ"00001"}

function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;  {ͨ}
{* ַָת}

function ByteToBin(Value: Byte): string; {ͨ}
{* ֽתƴ}

function StrRight(Str: string; Len: Integer): string;  {ͨ}
{* ַұߵַ   Examples: StrRight('ABCEDFG',3);   :'DFG' }

function StrLeft(Str: string; Len: Integer): string; {ͨ}
{* ַߵַ}

function Spc(Len: Integer): string;  {ͨ}
{* ؿո}

function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;  {ͨ}
{* ؽַָs1ַs2滻ִַ֧СдCaseSensitive}
{example: replace('We know what we want','we','I',false) = 'I Know what I want'}

function Replicate(pcChar:Char; piCount:integer):string;
{һַвĳַλ}

function StrNum(ShortStr:string;LongString:string):Integer;     {ͨ}
{* ĳַĳַгֵĴ}

function FindStr(ShortStr:String;LongStrIng:String):Integer;     {ͨ}
{* ĳַвĳַλ}

function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;     {ͨ}
{* شλBeginPlaceʼȡΪCatLengַ}

function LeftStr(psInput:String; CutLeng:Integer):String;     {ͨ}
{* شߵһΪʼȡ CutLengȵַ}

function RightStr(psInput:String; CutLeng:Integer):String;       {ͨ}
{* شұߵһΪʼȡ CutLengȵַ}

function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {ͨ}
{* شpsInputַ߿ʼpcPadWithܳΪPiWidthַ}

function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;       {ͨ}
{* شpsInputַұ߿ʼpcPadWithܳΪPiWidthַ}

function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {ͨ}
{* شpsInputַ߿ʼpcPadWithܳΪPiWidthַ}

function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;        {ͨ}
{* 滻ַ[滻ַ] Examples: ChrTran('abCdEgdlkh','d','#') 'abC#Eg#lkh'}

function StrTran(psInput:String; psSearch:String; psTranWith:String):String;        {ͨ}
{* 滻ַ[滻ַ] Examples: StrTran('aruyfbn','ruy','====='); 'a=====fbn'}

function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
{ *滻ַ[滻ַ] Examples: Stuff('ABCDEFGHI',3,4,'12345')'AB12345GHI'}

procedure SwapStr(var s1, s2: string);  {ͨ}
{* ִ}

function LinesToStr(const Lines: string): string;   {ͨ}
{* ıתУзת'\n'}

function StrToLines(const Str: string): string;    {ͨ}
{* ıתУ'\n'תз}

function Encrypt(const S: String; Key: Word): String;
{* ַܺ}

function Decrypt(const S: String; Key: Word): String;
{* ַܺ}

function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant;
function varToStr(const V: Variant): string;
{* VarIIFVartoStrΪ庯}

function IsDigital(Value: string): boolean;
{˵жstringǷȫ}

function RandomStr(aLength : Longint) : String;
{ַ}

//============================================================//
//================ չʱ  =================//
//============================================================//

function GetYear(Date: TDate): Integer;   {ͨ}
{* ȡݷ}
function GetMonth(Date: TDate): Integer;   {ͨ}
{* ȡ·ݷ}
function GetDay(Date: TDate): Integer;   {ͨ}
{* ȡ}
function GetHour(Time: TTime): Integer;   {ͨ}
{* ȡʱСʱ}
function GetMinute(Time: TTime): Integer;   {ͨ}
{* ȡʱӷ}
function GetSecond(Time: TTime): Integer;   {ͨ}
{* ȡʱ}
function GetMSecond(Time: TTime): Integer;   {ͨ}
{* ȡʱ}
function GetMonthLastDay(Cs_Year,Cs_Month:string):string;
{ *ꡢ£õ·һ}
function IsLeapYear( nYear: Integer ): Boolean;
{*/жĳǷΪ}
function MaxDateTime(const Values: array of TDateTime): TDateTime;
{//ȡϴ}
function MinDateTime(const Values: array of TDateTime): TDateTime;
{//ȡС}
function dateBeginOfMonth(D: TDateTime): TDateTime;
{//õµĵһ}
function DateEndOfMonth(D: TDateTime): TDateTime;
{//õµһ}
function DateEndOfYear(D: TDateTime): TDateTime;
{//õһ}
function DaysBetween(Date1, Date2: TDateTime): integer;
{//õ}

//============================================================//
//=================== չλ  ====================//
//============================================================//

type
  TByteBit = 0..7;
  {* ByteλΧ}
  TWordBit = 0..15;
  {* WordλΧ}
  TDWordBit = 0..31;
  {* DWordλΧ}

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
{* öλ}
procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
{* öλ}
procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
{* öλ}

function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
{* ȡλ}
function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
{* ȡλ}
function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
{* ȡλ}

//============================================================//
//=================չļĿ¼=================//
//============================================================//

function MoveFile(const sName, dName: string): Boolean;  {ͨ}
{* ƶļĿ¼ΪԴĿ}

procedure FileProperties(const FName: string); {ͨ}
{* ļԴ}

function OpenDialog(var FileName: string; Title: string; Filter: string;
  Ext: string): Boolean;
{* ļ}

function FormatPath(APath: string; Width: Integer): string; {ͨ}
{* ʾµĳ·}

function GetRelativePath(Source, Dest: string): string;  {ͨ}
{* ȡĿ¼·,ע⴮β'\'ַ}

procedure RunFile(const FName: string; Handle: THandle = 0;
  const Param: string = '');   {ͨ}
{* һļ}

function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL):
  Integer; {ͨ}
{* һļȴ}

function AppPath: string; {ͨ}
{* Ӧó·}

function GetWindowsDir: string; {ͨ}
{* ȡWindowsϵͳĿ¼}

function GetWinTempDir: string;  {ͨ}
{* ȡʱļĿ¼}

function AddDirSuffix(Dir: string): string;  {ͨ}
{* Ŀ¼β'\'}

function MakePath(Dir: string): string;  {ͨ}
{* Ŀ¼β'\'}

function IsFileInUse(FName: string): Boolean;   {ͨ}
{* жļǷʹ}

function GetFileSize(FileName: string): Integer;   {ͨ}
{* ȡļ}

function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;     {ͨ}
{* ļʱ Example:    FileSetDate('c:\Test\Test1.exe',753160662);    }

function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;     {ͨ}
{* ȡļʱ}

function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;  {ͨ}
{* ļʱתʱ}

function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;  {ͨ}
{* ʱתļʱ}

function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;   {ͨ}
{* ȡļصͼ꣬ɹ򷵻True}

function CreateBakFile(FileName, Ext: string): Boolean;   {ͨ}
{* ļ}

function Deltree(Dir: string): Boolean;    {ͨ}
{* ɾĿ¼}

function GetDirFiles(Dir: string): Integer;    {ͨ}
{* ȡļļ}

type
  TFindCallBack = procedure(const FileName: string; const Info: TSearchRec;
    var Abort: Boolean);
{* ָĿ¼ļĻص}

procedure FindFile(const Path: string; const FileName: string = '*.*';
  Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
{* ָĿ¼ļ}

procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);
{ ˵һ·µļ
   path:·,filter:ļչ,FileList:ļб, ContainSubDir:ǷĿ¼}

function Txtline(const txt: string): integer;
{* һıļ}

function Html2Txt(htmlfilename: string): string;
{* Htmlļתıļ}

function OpenWith(const FileName: string): Integer;     {ͨ}
{* ļ򿪷ʽ}

//============================================================//
//====================չĶԻ======================//
//============================================================//

procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer
  = MB_OK + MB_ICONINFORMATION);  {ͨ}
{* ʾʾ}

function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean;   {ͨ}
{* ʾʾȷϴ}

procedure ErrorDlg(Mess: string; Caption: string = SCnError);    {ͨ}
{* ʾ󴰿}

procedure WarningDlg(Mess: string; Caption: string = SCnWarning);  {ͨ}
{* ʾ洰}

function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean;   {ͨ}
{* ʾѯǷ񴰿}

procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool);

//============================================================//
//=====================ϵͳܺ=========================//
//============================================================//

procedure MoveMouseIntoControl(AWinControl: TControl);   {ͨ}
{* ƶ굽ؼ}

function DynamicResolution(x, y: WORD): Boolean;    {ͨ}
{* ̬÷ֱ}

procedure StayOnTop(Handle: HWND; OnTop: Boolean);   {ͨ}
{* Ϸʾ}

procedure SetHidden(Hide: Boolean);    {ͨ}
{* óǷ}

procedure SetTaskBarVisible(Visible: Boolean);    {ͨ}
{* Ƿɼ}

procedure SetDesktopVisible(Visible: Boolean);    {ͨ}
{* Ƿɼ}

procedure BeginWait;    {ͨ}
{* ʾȴ}

procedure EndWait;    {ͨ}
{* ȴ}

function CheckWindows9598NT: string;  {ͨ}
{* ǷWin95/98/NTƽ̨}

function GetOSInfo : String;   {ͨ}
{* ȡõǰƽ̨ Windows 95/98 NT}

function GetCurrentUserName : string;
{*ȡǰWindows¼û}

function GetRegistryOrg_User(UserKeyType:string):string;
{*ȡǰעĵλû}

function GetSysVersion:string;
{*//ȡϵͳ汾}

function WinBootMode:string;
{//Windowsģʽ}

type
   PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate);
procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);
{//Windows ShutDown}

//============================================================//
//=====================Ӳܺ=========================//
//============================================================//

function GetClientGUID:string;
{ ڱϵõһGUID.ȥ˵Ĵźмĺ
  ֵȥ˵ĴźмĺߵһGUID
  ÷Χwindows
}

function SoundCardExist: Boolean;       {ͨ}
{* Ƿ}

function GetDiskSerial(DiskChar: Char): string;
{* ȡк}

function DiskReady(Root: string) : Boolean;
{*׼Ƿ}

procedure WritePortB( wPort : Word; bValue : Byte );
{* д}

function ReadPortB( wPort : Word ) : Byte;
{*}

function CPUSpeed: Double;
{* ֪ǰCPUʣMHz}

type
	TCPUID	= array[1..4] of Longint;
function GetCPUID : TCPUID; assembler; register;
{*ȡCPUıʶID*}

function GetMemoryTotalPhys : Dword;
{*ȡڴ}

type
   TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES);
function DriveState (driveletter: Char) : TDriveState;
{* AдǷЧ}

//============================================================//
//=====================繦ܺ=========================//
//============================================================//
function GetComputerName:string;
{* ȡ}
function GetHostIP:string;
{* ȡIPַ}
function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword';
{* // ƽ̨Windows NT/2000/XP
{* // Windows 95/98/Meƽ̨øú޸ûWindows¼}


//============================================================//
//=====================Ẻƴܺ=====================//
//============================================================//
function GetHzPy(const AHzStr: string): string;       {ͨ}
{* ȡֵƴ}

function HowManyChineseChar(Const s:String):Integer;
{* жһַжٸ}

//============================================================//
//===================ݿ⹦ܺ===================//
//============================================================//
{function PackDbDbf(Var StatusMsg: String): Boolean;}
{* ɾݿ(DbDbf)е[ɾǵļ¼]}


procedure RepairDb(DbName: string);
{* ޸Access}

function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean;
{* ͨעODBC[ϵͳDSNҳ]}

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;
{* AdoSysBaseݿ⺯}

function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean;
{* Adoݿ⺯}

function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean;
{* AdoODBCͬݿ⺯}

function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;
{* //±}

function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;
{*//ڱֶ}

function KillField(LpFieldName:string):String;
{* //ڱɾֶ}

function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;
{* //޸ıṹ}

function GetSQLSentence(LpTableName,LpSQLsentence:string): string;
{* /޸ġӡɾṹʱSQL}


//============================================================//
//======================Ͻƺ======================//
//============================================================//

function StrToHex(AStr: string): string;
{* ַתʮ}

function HexToStr(AStr: string): string;
{* ʮתַ}

function TransChar(AChar: Char): Integer;

//============================================================//
//============================================//
//============================================================//

function TrimInt(Value, Min, Max: Integer): Integer; overload;    {ͨ}
{* Min..Max֮}

function IntToByte(Value: Integer): Byte; overload;   {ͨ}
{* 0..255֮}

function InBound(Value: Integer; Min, Max: Integer): Boolean;    {ͨ}
{* жValueǷMinMax֮}

procedure CnSwap(var A, B: Byte); overload;
{* }
procedure CnSwap(var A, B: Integer); overload;
{* }
procedure CnSwap(var A, B: Single); overload;
{* }
procedure CnSwap(var A, B: Double); overload;
{* }

function RectEqu(Rect1, Rect2: TRect): Boolean;
{* ȽRectǷ}

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
{* ֽһTRectΪϽx, yͿWidth߶Height}

function EnSize(cx, cy: Integer): TSize;
{* һTSize}

function RectWidth(Rect: TRect): Integer;
{* TRectĿ}

function RectHeight(Rect: TRect): Integer;
{* TRectĸ߶}

procedure Delay(const uDelay: DWORD);     {ͨ}
{* ʱ}

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);     {Win9X²ͨ}
{* ֻWin9Xȷ}

procedure ShowLastError;       {ͨ}
{* ʾWin32 ApiнϢ}

function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;
{* Font.StyleдINIļ}

function readFontStyle(inifile: string): TFontStyles;
{* INIļжȡFont.Styleļ}

//function ReadCursorPos(SourceMemo: TMemo): TPoint;
function ReadCursorPos(SourceMemo: TMemo): string;
{* ȡTMemo ؼǰкϢTpoint}

function CanUndo(AMemo: TMemo): Boolean;
{* TmemoؼܷUndo}

procedure Undo(Amemo: Tmemo);
{*ʵUndo}

procedure AutoListDisplay(ACombox:TComboBox);
{* ʵComBoBoxԶ}

function UpperMoney(small:real):string;
{* СдתΪд }

function Myrandom(Num: Integer): integer;
{*ϵͳʱ)}

procedure OpenIME(ImeName: string);
{*뷨}

procedure CloseIME;
{*ر뷨}

procedure ToChinese(hWindows: THandle; bChinese: boolean);
{*뷨}

//ݱ
procedure BackUpData(LpBackDispMessTitle:String);


implementation  {=======忪ʼ==========}

//============================================================//
//==================չַ====================//
//============================================================//

// жs1Ƿs2
function InStr(const sShort: string; const sLong: string): Boolean;
var
  s1, s2: string;
begin
  s1 := LowerCase(sShort);
  s2 := LowerCase(sLong);
  Result := Pos(s1, s2) > 0;
end;

// չתֱַΪĿȡַĬΪ
function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
begin
  Result := IntToStr(Value);
  while Length(Result) < Len do
    Result := FillChar + Result;
end;

// ַָת
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
var
  s: string;
  i, j: Integer;
begin
  s := IntToStr(Value);
  Result := '';
  j := 0;
  for i := Length(s) downto 1 do
  begin
    Result := s[i] + Result;
    Inc(j);
    try
       if ((j mod SpLen) = 0) and (i <> 1) then
          Result := Sp + Result;
    except
       MessageBox(Application.Handle,' IntToStrSpĵڶֵΪ0 ',SCnError,16);
       exit;
    end
  end;
end;

// ַұߵַ
function StrRight(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, Length(Str) - Len + 1, Len);
end;

// ַߵַ
function StrLeft(Str: string; Len: Integer): string;
begin
  if Len >= Length(Str) then
    Result := Str
  else
    Result := Copy(Str, 1, Len);
end;

// ֽתƴ
function ByteToBin(Value: Byte): string;
const
  V: Byte = 1;
var
  i: Integer;
begin
  for i := 7 downto 0 do
    if (V shl i) and Value <> 0 then
      Result := Result + '1'
    else
      Result := Result + '0';
end;

// ؿո
function Spc(Len: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Len - 1 do
    Result := Result + ' ';
end;

// ؽַָs1ַs2滻ִַ֧СдCaseSensitive}
function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;
var
   i:integer;
   s,t:string;
begin
   s:='';
   t:=str;
   repeat
      if casesensitive then
         i:=pos(s1,t)
      else
         i:=pos(lowercase(s1),lowercase(t));
         if i>0 then
            begin
               s:=s+Copy(t,1,i-1)+s2;
               t:=Copy(t,i+Length(s1),MaxInt);
            end
         else
            s:=s+t;
   until i<=0;
   result:=s;
end;

function Replicate(pcChar:Char; piCount:integer):string;
begin
	Result:='';
	SetLength(Result,piCount);
	fillChar(Pointer(Result)^,piCount,pcChar)
end;

// ĳַĳַгֵĴ}
function StrNum(ShortStr:string;LongString:string):Integer;     {ͨ}
var
   i:Integer;
begin
   i:=0;
   while pos(ShortStr,LongString)>0 do
      begin
         i:=i+1;
         LongString:=Substr(LongString,(FindStr(ShortStr,LongString))+1,Length(LongString)-FindStr(ShortStr,LongString))
      end;
   Result:=i;
end;

// ĳַвĳַλ}
function FindStr(ShortStr:String;LongStrIng:String):Integer;//һַĳַλ
var
   locality:integer;
begin
   locality:=Pos(ShortStr,LongStrIng);
   if locality=0 then
      Result:=0
   else
      Result:=locality;
end;

// شλBeginPlaceʼȡΪCatLengַ}
function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;
begin
	Result:=Copy(psInput,BeginPlace,CutLeng)
end;

// شߵһΪʼȡ CutLengȵַ
function LeftStr(psInput:String; CutLeng:Integer):String;
begin
	Result:=Copy(psInput,1,CutLeng)
end;

// شߵһΪʼȡ CutLengȵַ
function RightStr(psInput:String; CutLeng:Integer):String;
begin
	Result:=Copy(psInput,Length(psInput)-CutLeng+1,CutLeng)
end;

{* شpsInputַ߿ʼpcPadWithܳΪPiWidthַ}
function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=Replicate(pcPadWith,piWidth-Length(psInput))+psInput
end;

{* شpsInputַұ߿ʼpcPadWithܳΪPiWidthַ}
function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
	Result:=psInput+Replicate(pcPadWith,piWidth-Length(psInput))
end;

{* شpsInputַ߿ʼpcPadWithܳΪPiWidthַ}
function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
var
	liHalf :integer;
begin
	liHalf:=(piWidth-Length(psInput))div 2;
	Result:=Replicate(pcPadWith,liHalf)+psInput+Replicate(pcPadWith,piWidth-Length(psInput)-liHalf)
end;

{* 滻ַ Examples: ChrTran('abCdEgdlkh','d','#') 'bC#Eg#lkh'}
function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;
var
	i,j:integer;
begin
	j:=Length(psInput);
	for i:=1 to j do
  begin
		if psInput[i]=pcSearch then
			psInput[i]:=pcTranWith
  end;
	Result:=psInput
end;

{* 滻ַ Examples: StrTran('aruyfbn','ruy','====='); 'a=====fbn'}
function StrTran(psInput:String; psSearch:String; psTranWith:String):String;
var
	liPosition,liLenOfSrch,liLenOfIn:integer;
begin
	liPosition:=Pos(psSearch,psInput);
	liLenOfSrch:=Length(psSearch);
	liLenOfIn:=Length(psInput);
	while liPosition>0 do
	begin
		psInput:=Copy(psInput,1,liPosition-1)
			+psTranWith
      +Copy(psInput,liPosition+liLenOfSrch,liLenOfIn);
		liPosition:=Pos(psSearch,psInput)
	end;
	Result:=psInput
end;

{ *滻ַ[滻ַ] Examples: Stuff('ABCDEFGHI',3,4,'12345')'AB12345GHI'}
function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
begin
	Result:=Copy(psInput,1,piBeginPlace-1)+
		psStuffWith+
    Copy(psInput,piBeginPlace+piCount,Length(psInput))
end;

// ִ
procedure SwapStr(var s1, s2: string);
var
  tempstr: string;
begin
  tempstr := s1;
  s1 := s2;
  s2 := tempstr;
end;

const
  csLinesCR = #13#10;
  csStrCR = '\n';

// ıתУзת'\n'
function LinesToStr(const Lines: string): string;
var
  i: Integer;
begin
  Result := Lines;
  i := Pos(csLinesCR, Result);
  while i > 0 do
  begin
    system.Delete(Result, i, Length(csLinesCR));
    system.insert(csStrCR, Result, i);
    i := Pos(csLinesCR, Result);
  end;
end;

// ıתУ'\n'תз
function StrToLines(const Str: string): string;
var
  i: Integer;
begin
  Result := Str;
  i := Pos(csStrCR, Result);
  while i > 0 do
  begin
    system.Delete(Result, i, Length(csStrCR));
    system.insert(csLinesCR, Result, i);
    i := Pos(csStrCR, Result);
  end;
end;

//ַܺ
function Encrypt(const S: String; Key: Word): String;
var
   I : Integer;
begin
      Result := S;
      for I := 1 to Length(S) do
      begin
         Result[I] := char(byte(S[I]) xor (Key shr 8));
         Key := (byte(Result[I]) + Key) * C1 + C2;
         if Result[I] = Chr(0) then
            Result[I] := S[I];
      end;
      Result := StrToHex(Result);
end;

//ַܺ
function Decrypt(const S: String; Key: Word): String;
var
   I: Integer;
   S1: string;
begin
   S1 := HexToStr(S);
   Result := S1;
   for I := 1 to Length(S1) do
   begin
      if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then
         begin
            Result[I] := S1[I];
            Key := (byte(Chr(0)) + Key) * C1 + C2; //֤Keyȷԡ
         end
      else
         begin
            Result[I] := char(byte(S1[I]) xor (Key shr 8));
            Key := (byte(S1[I]) + Key) * C1 + C2;
         end;
   end;
end;

///VarIIF,VarTostrΪ庯
function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant;
begin
  if aTest then Result := TrueValue else Result := FalseValue;
end;

function varToStr(const V: Variant): string;
begin
  case TVarData(v).vType of
    varSmallInt: Result := IntToStr(TVarData(v).VSmallInt);
    varInteger: Result := IntToStr(TVarData(v).VInteger);
    varSingle: Result := FloatToStr(TVarData(v).VSingle);
    varDouble: Result := FloatToStr(TVarData(v).VDouble);
    varCurrency: Result := FloatToStr(TVarData(v).VCurrency);
    varDate: Result := DateToStr(TVarData(v).VDate);
    varBoolean: Result := varIIf(TVarData(v).VBoolean, 'True', 'False');
    varByte: Result := IntToStr(TVarData(v).VByte);
    varString: Result := StrPas(TVarData(v).VString);
    varEmpty,
      varNull,
      varVariant,
      varUnknown,
      varTypeMask,
      varArray,
      varByRef,
      varDispatch,
      varError: Result := '';
  end;
end;

{˵жstringǷȫ}
function IsDigital(Value: string): boolean;
var
  i, j: integer;
  str: char;
begin
  result := true;
  Value := trim(Value);
  j := Length(Value);
  if j = 0 then
  begin
    result := false;
    exit;
  end;
  for i := 1 to j do
  begin
    str := Value[i];
    if not (str in ['0'..'9']) then
    begin
      result := false;
      exit;
    end;
  end;
end;

{ַ}
function RandomStr(aLength : Longint) : String;
var
  X : Longint;
begin
  if aLength <= 0 then exit;
  SetLength(Result, aLength);
  for X:=1 to aLength do
    Result[X] := Chr(Random(26) + 65);
end;

//============================================================//
//==================չʱ====================//
//============================================================//

function GetYear(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := y;
end;

function GetMonth(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := m;
end;

function GetDay(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := d;
end;

function GetHour(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := h;
end;

function GetMinute(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := m;
end;

function GetSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := s;
end;

function GetMSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := ms;
end;

//ꡢ£õ·һ
function GetMonthLastDay(Cs_Year,Cs_Month:string):string;
Var
   V_date:Tdate;
   V_year,V_month,V_day:word;
begin
   V_year:=strtoint(Cs_year);
   V_month:=strtoint(Cs_month);
   if V_month=12 then
	   begin
   	   V_month:=1;
      	inc(V_year);
   	end
   else
   	inc(V_month);
	V_date:=EncodeDate(V_year,V_month,1);
	V_date:=V_date-1;
	DecodeDate(V_date,V_year,V_month,V_day);
	Result:=DateToStr(EncodeDate(V_year,V_month,V_day));
end;

//жĳǷΪ
function IsLeapYear( nYear: Integer ): Boolean;
begin
  Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0));
end;

//ȡϴ
function MaxDateTime(const Values: array of TDateTime): TDateTime;
var
  I: Cardinal;
begin
  Result := Values[0];
  for I := 0 to Low(Values) do
    if Values[I] < Result then Result := Values[I];
end;

//ȡС
function MinDateTime(const Values: array of TDateTime): TDateTime;
var
  I: Cardinal;
begin
  Result := Values[0];
  for I := 0 to High(Values) do
    if Values[I] < Result then Result := Values[I];
end;

//õµĵһһ
function dateBeginOfMonth(D: TDateTime): TDateTime;
var
  Year, Month, Day: Word;
begin
  DecodeDate(D, Year, Month, Day);
  Result := EncodeDate(Year, Month, 1);
end;

//õµһ
function dateEndOfMonth(D: TDateTime): TDateTime;
var
  Year, Month, Day: Word;
begin
  DecodeDate(D, Year, Month, Day);
  if Month = 12 then
  begin
    Inc(Year);
    Month := 1;
  end else
    Inc(Month);
  Result := EncodeDate(Year, Month, 1) - 1;
end;

//õһ
function dateEndOfYear(D: TDateTime): TDateTime;
var
  Year, Month, Day: Word;
begin
  DecodeDate(D, Year, Month, Day);
  Result := EncodeDate(Year, 12, 31);
end;

//õ
function DaysBetween(Date1, Date2: TDateTime): integer;
begin
  Result := Trunc(Date2) - Trunc(Date1) + 1;
  if Result < 0 then Result := 0;
end;
//============================================================//
//=====================λ===========================//
//============================================================//

// λ
procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean);
begin
  if IsSet then
    Value := Value or (1 shl Bit)
  else
    Value := Value and not (1 shl Bit);
end;

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean);
begin
  if IsSet then
    Value := Value or (1 shl Bit)
  else
    Value := Value and not (1 shl Bit);
end;

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean);
begin
  if IsSet then
    Value := Value or (1 shl Bit)
  else
    Value := Value and not (1 shl Bit);
end;

// ȡλ
function GetBit(Value: Byte; Bit: TByteBit): Boolean;
begin
  Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: WORD; Bit: TWordBit): Boolean;
begin
  Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean;
begin
  Result := Value and (1 shl Bit) <> 0;
end;

//============================================================//
//=================չļĿ¼=================//
//============================================================//

// ƶļĿ¼
function MoveFile(const sName, dName: string): Boolean;
var
  s1, s2: AnsiString;
  lpFileOp: TSHFileOpStruct;
begin
  s1 := PChar(sName) + #0#0;
  s2 := PChar(dName) + #0#0;
  with lpFileOp do
  begin
    Wnd := Application.Handle;
    wFunc := FO_MOVE;
    pFrom := PChar(s1);
    pTo := PChar(s2);
    fFlags := FOF_ALLOWUNDO;
    hNameMappings := nil;
    lpszProgressTitle := nil;
    fAnyOperationsAborted := True;
  end;
  Result := SHFileOperation(lpFileOp) = 0;
end;

// ļԴ
procedure FileProperties(const FName: string);
var
  SEI: SHELLEXECUTEINFO;
begin
  with SEI do
  begin
    cbSize := SizeOf(SEI);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or
      SEE_MASK_FLAG_NO_UI;
    Wnd := Application.Handle;
    lpVerb := 'properties';
    lpFile := PChar(FName);
    lpParameters := nil;
    lpDirectory := nil;
    nShow := 0;
    hInstApp := 0;
    lpIDList := nil;
  end;
  ShellExecuteEx(@SEI);
end;

// ʾµĳ·
function FormatPath(APath: string; Width: Integer): string;
var
  SLen: Integer;
  i, j: Integer;
  TString: string;
begin
  SLen := Length(APath);
  if (SLen <= Width) or (Width <= 6) then
  begin
    Result := APath;
    Exit
  end
  else
  begin
    i := SLen;
    TString := APath;
    for j := 1 to 2 do
    begin
      while (TString[i] <> '\') and (SLen - i < Width - 8) do
        i := i - 1;
      i := i - 1;
    end;
    for j := SLen - i - 1 downto 0 do
      TString[Width - j] := TString[SLen - j];
    for j := SLen - i to SLen - i + 2 do
      TString[Width - j] := '.';
    Delete(TString, Width + 1, 255);
    Result := TString;
  end;
end;

// ļ
function OpenDialog(var FileName: string; Title: string; Filter: string;
  Ext: string): Boolean;
var
  OpenName: TOPENFILENAME;
  TempFilename, ReturnFile: string;
begin
  with OpenName do
  begin
    lStructSize := SizeOf(OpenName);
    hWndOwner := GetModuleHandle('');
    Hinstance := SysInit.Hinstance;
    lpstrFilter := PChar(Filter + #0 + Ext + #0#0);
    lpstrCustomFilter := '';
    nMaxCustFilter := 0;
    nFilterIndex := 1;
    nMaxFile := MAX_PATH;
    SetLength(TempFilename, nMaxFile + 2);
    lpstrFile := PChar(TempFilename);
    FillChar(lpstrFile^, MAX_PATH, 0);
    SetLength(TempFilename, nMaxFile + 2);
    nMaxFileTitle := MAX_PATH;
    SetLength(ReturnFile, MAX_PATH + 2);
    lpstrFileTitle := PChar(ReturnFile);
    FillChar(lpstrFile^, MAX_PATH, 0);
    lpstrInitialDir := '.';
    lpstrTitle := PChar(Title);
    Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING;
    nFileOffset := 0;
    nFileExtension := 0;
    lpstrDefExt := PChar(Ext);
    lCustData := 0;
    lpfnHook := nil;
    lpTemplateName := '';
  end;
  Result := GetOpenFileName(OpenName);
  if Result then
    FileName := ReturnFile
  else
    FileName := '';
end;

// ȡĿ¼·,ע⴮β'\'ַ!
function GetRelativePath(Source, Dest: string): string;
  // Ƚ·ַͷͬĺ
  function GetPathComp(s1, s2: string): Integer;
  begin
    if Length(s1) > Length(s2) then swapStr(s1, s2);
    Result := Pos(s1, s2);
    while (Result = 0) and (Length(s1) > 3) do
    begin
      if s1 = '' then Exit;
      s1 := ExtractFileDir(s1);
      Result := Pos(s1, s2);
    end;
    if Result <> 0 then Result := Length(s1);
    if Result = 3 then Result := 2;
    // ExtractFileDir()'c:\'ʱĴ.
  end;
  // ȡDestԸ·ĺ
  function GetRoot(s: ShortString): string;
  var
    i: Integer;
  begin
    Result := '';
    for i := 1 to Length(s) do
      if s[i] = '\' then Result := Result + '..\';
    if Result = '' then Result := '.\';
    // 봦".\"·ʽȥ
  end;

var
  RelativRoot, RelativSub: string;
  HeadNum: Integer;
begin
  Source := UpperCase(Source);
  Dest := UpperCase(Dest);              // Ƚ·ַͷͬ
  HeadNum := GetPathComp(Source, Dest); // ȡDestԸ·
  RelativRoot := GetRoot(StrRight(Dest, Length(Dest) - HeadNum));
  // ȡSource·
  RelativSub := StrRight(Source, Length(Source) - HeadNum - 1);
  // 
  Result := RelativRoot + RelativSub;
end;

// һļ
procedure RunFile(const FName: string; Handle: THandle;
  const Param: string);
begin
  ShellExecute(Handle, nil, PChar(FName), PChar(Param), nil, SW_SHOWNORMAL);
end;

// һļȴ
function WinExecAndWait32(FileName: string; Visibility: Integer): Integer;
var
  zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                           { pointer to command line string }
    nil,                                { pointer to process security attributes }
    nil,                                { pointer to thread security attributes }
    False,                              { handle inheritance flag }
    CREATE_NEW_CONSOLE or               { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                                { pointer to new environment block }
    nil,                                { pointer to current directory name }
    StartupInfo,                        { pointer to STARTUPINFO }
    ProcessInfo) then
    Result := -1                        { pointer to PROCESS_INF }

  else
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
  end;
end;

// Ӧó·
function AppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

// ȡWindowsϵͳĿ¼
function GetWindowsDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := AddDirSuffix(Buf);
end;

// ȡʱļĿ¼
function GetWinTempDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, Buf);
  Result := AddDirSuffix(Buf);
end;

// Ŀ¼β'\'
function AddDirSuffix(Dir: string): string;
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function MakePath(Dir: string): string;
begin
  Result := AddDirSuffix(Dir);
end;

// жļǷʹ
function IsFileInUse(FName: string): Boolean;
var
  HFileRes: HFILE;
begin
  Result := False;
  if not FileExists(FName) then
    Exit;
  HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;

// ȡļ
function GetFileSize(FileName: string): Integer;
var
  FileVar: file of Byte;
begin
  {$I-}
  try
    AssignFile(FileVar, FileName);
    Reset(FileVar);
    Result := FileSize(FileVar);
    CloseFile(FileVar);
  except
    Result := 0;
  end;
  {$I+}
end;

// ļʱ
function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
var
  FileHandle: Integer;
begin
  FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  if FileHandle > 0 then
  begin
    SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime);
    FileClose(FileHandle);
    Result := True;
  end
  else
    Result := False;
end;

// ȡļʱ
function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
var
  FileHandle: Integer;
begin
  FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if FileHandle > 0 then
  begin
    GetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime);
    FileClose(FileHandle);
    Result := True;
  end
  else
    Result := False;
end;

// ȡļصͼ
// FileName: e.g. "e:\hao\a.txt"
// ɹ򷵻True
function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;
var
  SHFileInfo: TSHFileInfo;
  h: HWND;
begin
  if not Assigned(Icon) then
    Icon := TIcon.Create;
  h := SHGetFileInfo(PChar(FileName),
    0,
    SHFileInfo,
    SizeOf(SHFileInfo),
    SHGFI_ICON or SHGFI_SYSICONINDEX);
  Icon.Handle := SHFileInfo.hIcon;
  Result := (h <> 0);
end;

// ļʱתʱ
function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
var
  STime: TSystemTime;
begin
  FileTimeToLocalFileTime(FTime, FTime);
  FileTimeToSystemTime(FTime, STime);
  Result := STime;
end;

// ʱתļʱ
function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
var
  FTime: TFileTime;
begin
  SystemTimeToFileTime(STime, FTime);
  LocalFileTimeToFileTime(FTime, FTime);
  Result := FTime;
end;

// ļ
function CreateBakFile(FileName, Ext: string): Boolean;
var
  BakFileName: string;
begin
  BakFileName := FileName + '.' + Ext;
  Result := CopyFile(PChar(FileName), PChar(BakFileName), False);
end;

// ɾĿ¼
function Deltree(Dir: string): Boolean;
var
  sr: TSearchRec;
  fr: Integer;
begin
  if not DirectoryExists(Dir) then
  begin
    Result := True;
    Exit;
  end;
  fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
  try
    while fr = 0 do
    begin
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        if sr.Attr and faDirectory = faDirectory then
          Result := Deltree(AddDirSuffix(Dir) + sr.Name)
        else
          Result := DeleteFile(AddDirSuffix(Dir) + sr.Name);
        if not Result then
          Exit;
      end;
      fr := FindNext(sr);
    end;
  finally
    FindClose(sr);
  end;
  Result := RemoveDir(Dir);
end;

// ȡļļ
function GetDirFiles(Dir: string): Integer;
var
  sr: TSearchRec;
  fr: Integer;
begin
  Result := 0;
  fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
  while fr = 0 do
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
      Inc(Result);
    fr := FindNext(sr);
  end;
  FindClose(sr);
end;

var
  FindAbort: Boolean;

// ָĿ¼ļ
procedure FindFile(const Path: string; const FileName: string = '*.*';
  Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
var
  APath: string;
  Info: TSearchRec;
  Succ: Integer;
begin
  FindAbort := False;
  APath := MakePath(Path);
  try
    Succ := FindFirst(APath + FileName, faAnyFile - faVolumeID, Info);
    while Succ = 0 do
    begin
      if (Info.Name <> '.') and (Info.Name <> '..') then
      begin
        if (Info.Attr and faDirectory) <> faDirectory then
        begin
          if Assigned(Proc) then
            Proc(APath + Info.FindData.cFileName, Info, FindAbort);
        end
        else if bSub then
          FindFile(APath + Info.Name, FileName, Proc, bSub, bMsg);
      end;
      if bMsg then Application.ProcessMessages;
      if FindAbort then Exit;
      Succ := FindNext(Info);
    end;
  finally
    FindClose(Info);
  end;
end;

{ ˵һ·µļ
  path:·, filter:ļչ, FileList:ļб, ContainSubDir:ǷĿ¼}
procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);
var
  FSearchRec,DSearchRec:TSearchRec;
  FindResult:shortint;
begin
  FindResult:=FindFirst(path+Filter,sysutils.faAnyFile,FSearchRec);

  try
  while FindResult=0 do
  begin
    FileList.Add(FSearchRec.Name);
    FindResult:=FindNext(FSearchRec);
  end;
  
  if ContainSubDir then
  begin
    FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec);
    while FindResult=0 do
    begin
      if ((DSearchRec.Attr and faDirectory)=faDirectory)
        and (DSearchRec.Name<>'.') and (DSearchRec.Name<>'..') then
        FindFileList(Path,Filter,FileList,ContainSubDir);
        FindResult:=FindNext(DSearchRec);
    end;
  end;
  finally
    FindClose(FSearchRec);
  end;
end;
  
//һıļ
function Txtline(const txt: string): integer;
var
  F : TextFile; {趨Ϊıļ}
  StrLine : string; {ÿַ}
  line : Integer; {}
begin
  AssignFile(F, txt); {ļ}
  Reset(F);
  Line := 0;
  while not SeekEof(f) do {ļûβ}
  begin
    if SeekEoln(f) then {жǷβ}
      Readln;
    Readln(F, StrLine);
    if SeekEof(f) then
      break
    else
      inc(Line);
  end;
  CloseFile(F); {رļ}
  Result := Line;
end;

//Htmlļתıļ
function Html2Txt(htmlfilename: string): string;
var Mystring:TStrings;
    s,lineS:string;
    line,Llen,i,j:integer;
    rloop:boolean;
begin
   rloop:=False;
   Mystring:=TStringlist.Create;
   s:='';
   Mystring.LoadFromFile(htmlfilename);
   line:=Mystring.Count;
   try
      for i:=0 to line-1 do
         Begin
            lineS:=Mystring[i];
            Llen:=length(lineS);
            j:=1;
            while (j<=Llen)and(lineS[j]=' ')do
            begin
               j:=j+1;
               s:=s+' ';
            End;
            while j<=Llen do
            Begin
               if lineS[j]='<'then
                  rloop:=True;
                  if lineS[j]='>'then
                     Begin
                        rloop:=False;
                        j:=j+1;
                        continue;
                     End;
                  if rloop then
                     begin
                        j:=j+1;
                        continue;
                     end
                  else
                    s:=s+lineS[j];
                     j:=j+1;
            End;
            s:=s+#13#10;
         End;
   finally
      Mystring.Free;
   end;{try}
   result:=s;
end;

// ļ򿪷ʽ
function OpenWith(const FileName: string): Integer;
begin
  Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe',
    PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW);
end;

//============================================================//
//===================չĶԻ=======================//
//============================================================//

// ʾʾ
procedure InfoDlg(Mess: string; Caption: string; Flags: Integer);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), Flags);
end;

// ʾʾȷϴ
function InfoOk(Mess: string; Caption: string): Boolean;
begin
  Result := Application.MessageBox(PChar(Mess), PChar(Caption),
    MB_OK + MB_ICONINFORMATION) = IDOK;
end;

// ʾ󴰿
procedure ErrorDlg(Mess: string; Caption: string);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP);
end;

// ʾ洰
procedure WarningDlg(Mess: string; Caption: string);
begin
  Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING);
end;

// ʾѯǷ񴰿
function QueryDlg(Mess: string; Caption: string): Boolean;
begin
  Result := Application.MessageBox(PChar(Mess), PChar(Caption),
    MB_YESNO + MB_ICONQUESTION) = IDYES;
end;

//彥
procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool);
var
  pOSVersionInfo : OSVersionInfo;
begin
  pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
  GetVersionEx(pOSVersionInfo);
  if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    if IsSetAni then
      AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND);
  end
  else
    if IsSetAni then
    begin
      AnimateWindow(Sender.Handle,444,AW_HIDE or AW_CENTER);
    end;
end;

//============================================================//
//==================== ϵͳܺ  =======================//
//============================================================//

// ƶ굽ؼ
procedure MoveMouseIntoControl(AWinControl: TControl);
var
  rtControl: TRect;
begin
  rtControl := AWinControl.BoundsRect;
  MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2);
  SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2,
    rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2);
end;

// ̬÷ֱ
function DynamicResolution(x, y: WORD): Boolean;
var
  lpDevMode: TDeviceMode;
begin
  Result := EnumDisplaySettings(nil, 0, lpDevMode);
  if Result then
  begin
    lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    lpDevMode.dmPelsWidth := x;
    lpDevMode.dmPelsHeight := y;
    Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
  end;
end;

// Ϸʾ
procedure StayOnTop(Handle: HWND; OnTop: Boolean);
const
  csOnTop: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
begin
  SetWindowPos(Handle, csOnTop[OnTop], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

var
  WndLong: Integer;

// óǷ
procedure SetHidden(Hide: Boolean);
begin
  ShowWindow(Application.Handle, SW_HIDE);
  if Hide then
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
      WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST)
  else
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong);
  ShowWindow(Application.Handle, SW_SHOW);
end;

const
  csWndShowFlag: array[Boolean] of DWORD = (SW_HIDE, SW_RESTORE);

// Ƿɼ
procedure SetTaskBarVisible(Visible: Boolean);
var
  wndHandle: THandle;
begin
  wndHandle := FindWindow('Shell_TrayWnd', nil);
  ShowWindow(wndHandle, csWndShowFlag[Visible]);
end;

// Ƿɼ
procedure SetDesktopVisible(Visible: Boolean);
var
  hDesktop: THandle;
begin
  hDesktop := FindWindow('Progman', nil);
  ShowWindow(hDesktop, csWndShowFlag[Visible]);
end;

// ʾȴ
procedure BeginWait;
begin
  Screen.Cursor := crHourGlass;
end;  

// ȴ
procedure EndWait;
begin
  Screen.Cursor := crDefault;
end;

// ǷWin95/98ƽ̨
function CheckWindows9598NT: String;
var
   V: TOSVersionInfo;
begin
   V.dwOSVersionInfoSize := SizeOf(V);
   Result := 'δ֪ϵͳ';
   if not GetVersionEx(V) then Exit;
   if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
      Result := 'Windows 95/98'
   else
      begin
         if V.dwPlatformId = VER_PLATFORM_WIN32_NT then
            Result := 'Windows NT'
         else
            Result :='Windows'
      end;
end;

{* ȡõǰƽ̨ Windows 95/98 NT}
function GetOSInfo : String;
begin
   Result := '';
   case Win32Platform of
      VER_PLATFORM_WIN32_WINDOWS: Result := 'Windows 95/98';
      VER_PLATFORM_WIN32_NT: Result := 'Windows NT';
   else
      Result := 'Windows32';
   end;
end;

//*ȡǰWindows¼û
function GetCurrentUserName : string;
const
   cnMaxUserNameLen = 254;
var
   sUserName : string;
   dwUserNameLen : Dword;
begin
   dwUserNameLen := cnMaxUserNameLen-1;
   SetLength( sUserName, cnMaxUserNameLen );
   GetUserName(Pchar( sUserName ), dwUserNameLen );
   SetLength( sUserName, dwUserNameLen );
   Result := sUserName;
end;

function GetRegistryOrg_User(UserKeyType:string):string;
var
   Myreg:Tregistry;
   RegString:string;
begin
   MyReg:=Tregistry.Create;
   MyReg.RootKey:=HKEY_LOCAL_MACHINE;
   if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      RegString:='Software\Microsoft\Windows NT\CurrentVersion'
   else
      RegString:='Software\Microsoft\Windows\CurrentVersion';

   if MyReg.openkey(RegString,False) then
   begin
      if UpperCase(UserKeyType)='REGISTEREDORGANIZATION' then
         Result:= MyReg.readstring('RegisteredOrganization')
      else
         begin
            if UpperCase(UserKeyType)='REGISTEREDOWNER' then
               Result:= MyReg.readstring('RegisteredOwner')
            else
               Result:='';
         end;
   end;
   MyReg.CloseKey;
   MyReg.Free;
end;

//ȡϵͳ汾
function GetSysVersion:string;
Var
   OSVI:OSVERSIONINFO;
   ObjSysVersion:string;
begin
   OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO);
   GetVersionEx(OSVI);
   ObjSysVersion:=IntToStr(OSVI.dwMinorVersion)+','+IntToStr(OSVI.dwMinorVersion)+','
            +IntToStr(OSVI.dwBuildNumber)+','+IntToStr(OSVI.dwPlatformId)+','
            +OSVI.szCSDVersion;
   if rightstr(ObjSysVersion,1)=',' then
      ObjSysVersion:=Substr(ObjSysVersion,1,length(ObjSysVersion)-1);
   Result:=ObjSysVersion;
end;

//Windowsģʽ
function WinBootMode:string;
begin
   case(GetSystemMetrics(SM_CLEANBOOT)) of
      0:Result:='ģʽ';
      1:Result:='ȫģʽ';
      2:Result:='ȫģʽ繦';
   else
      Result:='ϵͳ⡣';
   end;
end;

////Windows ShutDown
procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);
var
  hToken, hProcess: THandle;
  tp, prev_tp: TTokenPrivileges;
  Len, Flags: DWORD;
  CanShutdown: Boolean;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);
    try
      if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
         Exit;
    finally
      CloseHandle(hProcess);
    end;
    try
      if not LookupPrivilegeValue('', 'SeShutdownPrivilege',
        tp.Privileges[0].Luid) then Exit;
      tp.PrivilegeCount := 1;
      tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),
        prev_tp, Len) then Exit;
    finally
      CloseHandle(hToken);
    end;
  end;
  CanShutdown := True;
//  DoQueryShutdown(CanShutdown);
  if not CanShutdown then Exit;
  if PForce then Flags := EWX_FORCE else Flags := 0;
  case ShutWinType of
    UPowerOff:  ExitWindowsEx(Flags or EWX_POWEROFF, 0);
    UShutdown:  ExitWindowsEx(Flags or EWX_SHUTDOWN, 0);
    UReboot:    ExitWindowsEx(Flags or EWX_REBOOT, 0);
    ULogoff:    ExitWindowsEx(Flags or EWX_LOGOFF, 0);
    USuspend:   SetSystemPowerState(True, PForce);
    UHibernate: SetSystemPowerState(False, PForce);
  end;
end;


//============================================================//
//=====================Ӳܺ=========================//
//============================================================//

function GetClientGUID:string;
var
  myGuid:TGUID;
  ResultStr:string;
begin
  CreateGuid(myGuid);
  ResultStr:=GUIDToString(myGuid);
  ResultStr:=Communal.Replace(ResultStr,'-','',False);
  ResultStr:=Communal.Replace(ResultStr,'{','',False);
  ResultStr:=Communal.Replace(ResultStr,'}','',False);
  Result:=Substr(ResultStr,1,30);
end;

// Ƿ
function SoundCardExist: Boolean;
begin
  Result := WaveOutGetNumDevs > 0;
end;

//* ȡк
function GetDiskSerial(DiskChar: Char): string;
var
   SerialNum : pdword;
   a, b : dword;
   Buffer : array [0..255] of char;
begin
   result := '';
   if GetVolumeInformation(PChar(diskchar+':\'), Buffer, SizeOf(Buffer), SerialNum,a, b, nil, 0) then
      Result := IntToStr(SerialNum^);
end;

//*׼Ƿ
function DiskReady(Root: string) : Boolean;
var
   Oem : CARDINAL ;
   Dw1,Dw2 : DWORD ;
begin
   Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ;
   if LENGTH(Root) = 1 then Root := Root + ':\\';
      Result := GetVolumeInformation( PCHAR( Root ), NIL,0,NIL, Dw1,Dw2, NIL,0 ) ;
   SetErrorMode( Oem ) ;
end;

//*Aд̵Ƿļļ״̬
function DriveState (driveletter: Char) : TDriveState;
var
   mask: String[6];
   sRec: TSearchRec;
   oldMode: Cardinal;
   retcode: Integer;
begin
   oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
   mask:= '?:\*.*';
   mask[1] := driveletter;
   {$I-}
   retcode := FindFirst (mask, faAnyfile, Srec);
   FindClose(Srec);
   {$I+}
   case retcode of
   0 : Result := DSDISK_WITHFILES; //ļ
   -18 : Result := DSEMPTYDISK; //õĿմ
   -21, -3: Result := DSNODISK; //NT,Win31Ĵ
   else
      Result := DSUNFORMATTEDDISK;
   end;
   SetErrorMode(oldMode);
end;

//д
procedure WritePortB( wPort : Word; bValue : Byte );
begin
   asm
   mov dx, wPort
   mov al, bValue
   out dx, al
   end;
end;

//
function ReadPortB( wPort : Word ):Byte;
begin
   asm
   mov dx, wPort
   in al, dx
   mov result, al
   end;
end;

//֪ǰCPUʣMHz
function CPUSpeed: Double;
const
   DelayTime = 500;
   var
   TimerHi, TimerLo: DWORD;
   PriorityClass, Priority: Integer;
begin
   PriorityClass := GetPriorityClass(GetCurrentProcess);
   Priority := GetThreadPriority(GetCurrentThread);
   SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
   SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
   Sleep(10);
   asm
   dw 310Fh
   mov TimerLo, eax
   mov TimerHi, edx
   end;
   Sleep(DelayTime);
   asm
   dw 310Fh
   sub eax, TimerLo
   sbb edx, TimerHi
   mov TimerLo, eax
   mov TimerHi, edx
   end;
   SetThreadPriority(GetCurrentThread, Priority);
   SetPriorityClass(GetCurrentProcess, PriorityClass);
   Result := TimerLo / (1000.0 * DelayTime);
end;

//ȡCPUıʶID
function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD			          {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI					{Restore registers}
  POP     EBX
end;

//ȡڴ
function GetMemoryTotalPhys : Dword;
var
   memStatus: TMemoryStatus;
begin
   memStatus.dwLength := sizeOf ( memStatus );
   GlobalMemoryStatus ( memStatus );
   Result := memStatus.dwTotalPhys div 1024;
end;

//============================================================//
//=====================繦ܺ=========================//
//============================================================//

{* ȡ}
function GetComputerName:string;
var
   wVersionRequested : WORD;
   wsaData : TWSAData;
   p : PHostEnt; s : array[0..128] of char;
begin
   try
      wVersionRequested := MAKEWORD(1, 1); // WinSock
      WSAStartup(wVersionRequested, wsaData); // WinSock
      GetHostName(@s,128);
      p:=GetHostByName(@s);
      Result:=p^.h_Name;
   finally
      WSACleanup; //ͷ WinSock
   end;
end;

{* ȡIPַ}
function GetHostIP:string;
var
   wVersionRequested : WORD;
   wsaData : TWSAData;
   p : PHostEnt; s : array[0..128] of char; p2 : pchar;
begin
   try
      wVersionRequested := MAKEWORD(1, 1); // WinSock
      WSAStartup(wVersionRequested, wsaData); // WinSock
      GetHostName(@s,128);
      p:=GetHostByName(@s);
      p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
      Result:= P2;
   finally
      WSACleanup; //ͷ WinSock
   end;
end;

//============================================================//
//=====================Ẻƴܺ=====================//
//============================================================//
// ȡֵƴ
function GetHzPy(const AHzStr: string): string;
const
  ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
    (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
    (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
    (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
    (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
  i, j, HzOrd: Integer;
begin
  Result:='';
  i := 1;
  while i <= Length(AHzStr) do
  begin
    if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
    begin
      HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
      for j := 0 to 25 do
      begin
        if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
        begin
          Result := Result + Char(Byte('A') + j);
          Break;
        end;
      end;
      Inc(i);
    end else Result := Result + AHzStr[i];
    Inc(i);
  end;
end;

{* жһַжٸ}
function HowManyChineseChar(Const s:String):Integer;
var
   SW:WideString;
   C:String;
   i, WCount:Integer;
begin
   SW:=s;
   WCount:=0;
   For i:=1 to Length(SW) do
   begin
      c:=SW[i];
      if Length(c)>1 then
         Inc(WCount);
   end;
   Result:=WCount;
end;

//============================================================//
//==================ݿ⹦ܺ====================//
//============================================================//

//* ɾݿ(DbDbf)е[ɾǵļ¼]}
{function PackDbDbf(Var StatusMsg: String): Boolean;
var
   rslt:DBIResult;
   szErrMsg:DBIMSG;
   pTblDesc:pCRTblDesc;
   bExclusive:Boolean;
   bActive:Boolean;
   isParadox,isDbase:Boolean;
   tempTableName:string;
   Props:CurProps;//
begin
   Result:=False;
   StatusMsg:='';
   if TableType=ttDefault then
      begin
         tempTableName:=TableName;
         tempTableName:=Lowercase(tempTableName);
         isParadox:=(pos('.db',tempTableName)>0) and (tempTableName[length(tempTableName)]='b');
         isDbase:=pos('.dbf',tempTableName)>0;
      end
   else
      begin
         isParadox:=TableType=ttParadox;
         isDbase:=TableType=ttDbase;
      end;
   if isparadox or isDbase then
      begin
         bExclusive:=Exclusive;
         bActive:=Active;
         DisableControls;
//         Close;
         Exculsive:=true;
      end
   else
      begin
         StatusMsg:='Чݱ͡';
         Exit;
      end;
   if isParadox then
      begin
         if wwMemAvail(Sizeof(CRTblDesc)) then
            begin
               StatusMsg:='ڴ治㣬ѹʧܡ';
            end
         else
            begin
               GetMem(pTblDesc,Sizeof(CRTblDesc));
               fillchar(pTblDesc^,Sizeof(CRTblDesc),0);
               with pTblDesc^ do
               begin
                  strCopy(szTblName,Tablename);
                  strCopy(szTblType,szParadox);
                  Active:=True;
                  Check(DbiGetCursorProps(handle,Props));//Ƿҿ
                  bProtected:=props.bProtected;
                  Active:=False;
                  bPack:=True;
               end;
               Screen.Cursor:=crHourGlass;
               SetDBFlag(dbfOpened,True);
               rslt:=DBIdoRestructure(DBHandle,1,pTblDesc,nil,nil,nil,False);
               if rslt<>DBIERR_NONE then
                  begin
                     DBiGetErrorString(rslt,SzErrMsg);
                     StatusMsg:=SzErrMsg;
                  end
               else
                  Result:=True;
               SetDBFlag(dbfOpened,False);
               FreeMem(pTblDesc,Sizeof(CRTlDesc));
               Screen.Cursor:=crDefault;
            end;
      end
   else
      if isDbase then
         begin
            Screen.Cursor:=crHourGlass;
            OPen;
            rslt:=dbiPacktable(DBHandle,Handle,nil,nil,True);
            Screen.Cursor:=crDefault;
            if rslt<>DBIERR_NONE then
               begin
                  DBiGetERRorString(rslt,szErrMsg);
                  StatusMSg:=SzErrMsg;
               end
            else
               Result:=True;
         end;
      Close;
      Exculsive:=bExclusive;
      Active:=bActive;
      EnableControls;
end;}


{procedure CompactDb(DbName, NewDbName: string);
var
   dao: OLEVariant;
begin
   dao := CreateOleObject('DAO.DBEngine.35');
   dao.CompactDatabase(DbName, NewDbName);
end;}

//޸Access
procedure RepairDb(DbName: string);
var
   Dao: OLEVariant;
begin
   Dao := CreateOleObject('DAO.DBEngine.35');
   Dao.RepairDatabase(DbName);
end;

//ͨעODBC[ϵͳDSNҳ]
function CreateODBCCfgInRegistry(ODBCSourceName:WideString; ServerName, DataBaseDescription:String):boolean;
var
  Reg: TRegistry;
  LPT_systemDir:array [1..255] of char;
  P:Pchar;
  DriverString:String;
begin
   Reg := TRegistry.Create;
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   try
      try
         if not Reg.KeyExists('\Software\ODBC\ODBC.INI\'+trim(ODBCSourceName)) then
         begin
            //
            if Reg.OpenKey('\Software\ODBC\ODBC.INI\'+trim(ODBCSourceName),True) then
            begin
               //дֵ
               Reg.WriteString('DataBase', ODBCSourceName);
               Reg.WriteString('Description',Trim(DataBaseDescription));

               GetSystemDirectory(@LPT_systemDir,255) ;
               P:=@LPT_systemDir;
               DriverString:=StrCat(P,Pchar('\SQLSRV32.DLL')) ;
               Reg.WriteString('Driver', DriverString);

               Reg.WriteString('LastUser', 'Administrator');
               Reg.WriteString('Server', trim(ServerName));
               Reg.WriteString('Trusted_Connection', 'Yes');
               reg.CloseKey;
            end;

            //ODBCDataSource
            if Reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources\',True) then
            begin
               Reg.DeleteValue(ODBCSourceName);
               Reg.WriteString(ODBCSourceName, 'SQL Server');
               Reg.CloseKey;
            end;
         end;
         Result:=True;
      except
         Result:=False;
      end;
   finally
      Reg.Free;
   end;
end;

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;
{* AdoSysBaseݿ⺯}
begin
   with Adocon do
     begin
          Close;
          LoginPrompt:=False;    //ݿⲻʱжϡ
          ConnectionString:='Provider=MSDASQL.1;'+
                            'Password="";'+
                            'Persist Security Info=True;'+
                            'Data Source=Sy_Finalact';
          try
              KeepConnection:=True;
              Screen.Cursor:=crHourGlass;
              Connected:=True;
              Open;
              Screen.Cursor:=crDefault;
              ADOConnectSysBase:=True;
          except
              ADOConnectSysBase:=False;
          end;
     end;
end;

//Adoݿ⺯
function ADOConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname,DBServerName:String;ValidateMode:Integer):boolean;
begin
   with Adocon do
     begin
          Close;
          LoginPrompt:=False;    //ݿⲻʱжϡ
          if ValidateMode=0 then//ʹWindows NT֤ģʽ
             ConnectionString:='Provider=SQLOLEDB.1;'+
                               'Password="";'+
                               'Integrated Security=SSPI;'+  //ɰȫ
                               'Persist Security Info=False;'+
                               'User ID=sa;Initial Catalog='+''''+dbname+''''+';'+
                               'Data Source='+''''+DBServerName+'''';

          if ValidateMode=1 then//ʹSQL SERVER֤ģʽ
             ConnectionString:='Provider=SQLOLEDB.1;'+
                               'Password="";'+
                               'Persist Security Info=True;'+
                               'User ID=sa;Initial Catalog='+''''+Dbname+''''+';'+
                               'Data Source='+''''+DBServerName+'''';
          try
              KeepConnection:=True;
              Screen.Cursor:=crHourGlass;
              Connected:=True;
              Open;
              Screen.Cursor:=crDefault;
              ADOConnectLocalDB:=True;
          except
              ADOConnectLocalDB:=False;
          end;
     end;
end;

//AdoODBCͬݿ⺯
function ADOODBCConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname:String;ValidateMode:Integer):boolean;
begin
   with Adocon do
     begin
          Close;
          LoginPrompt:=False;    //ݿⲻʱжϡ
          if ValidateMode=0 then//ʹWindows NT֤ģʽ
             ConnectionString:='Provider=MSDASQL.1;'+
                               'Password="";'+
                               'Persist Security Info=False;'+
                               'User ID=sa;Data Source='+''''+DBName+''''+';'+
                               'Initial Catalog='+''''+DBname+'''';

          if ValidateMode=1 then//ʹSQL SERVER֤ģʽ
             ConnectionString:='Provider=MSDASQL.1;'+
                               'Password="";'+
                               'Persist Security Info=True;'+
                               'User ID=sa;Data Source='+''''+DBName+''''+';'+
                               'Initial Catalog='+''''+DBname+'''';
          try
              KeepConnection:=True;
              Screen.Cursor:=crHourGlass;
              Connected:=True;
              Open;
              Screen.Cursor:=crDefault;
              ADOODBCConnectLocalDB:=True;
          except
              ADOODBCConnectLocalDB:=False;
          end;
     end;
end;

///ָݿн
function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;//±
Var
   CreatTableQuery:TQuery;
   SQLsentence:string;
   Successed:Boolean;//ɹ
begin
   Successed:=False;
   SQLsentence:='CREATE TABLE "'+ LpTableName +'" ' + LpSentence;
   CreatTableQuery:=TQuery.Create(nil);
   try
      try
         with CreatTableQuery do
         begin
            UniDirectional:=True;
            Active:=False;
            Sql.Clear;
            DataBaseName := LpDataBaseName; //ݿ
            Sql.Add(SQLsentence);
            ExecSQL;
            Successed:=True;
         end;
      except
         MessageBox(Application.Handle,Pchar(' ڽݿ '+Trim(LpDataBaseName)+' е '+Trim(LpTableName)+' δܳɹ '),'ʧ',0+16);
         Successed:=False;
      end;
   finally
      CreatTableQuery.Free;//ͷŽQuery
      if Successed then
         Result:=True//ɹ
      else
         Result:=False;//ʧ
   end;
end;

//ָıֶ
function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;//±
var
   Sentence,SQLsentence : string;
begin
   Sentence:= '';
   SQLsentence:='';
   if LpFieldName = '' then
      raise EDBUpdateErr.Create('ֶΪ');
   if Pos(' ', LpFieldName) <> 0 then
      raise EDBUpdateErr.Create('ֶвܺпոַ');
   if LpDataType = ftString then
      sentence := 'ADD '+LpFieldName+' Char('+ IntToStr( LpSize ) + ')';
   if LpDataType = ftInteger then
      sentence := 'ADD '+LpFieldName+' Integer';
   if LpDataType = ftSmallInt then
      sentence := 'ADD '+LpFieldName+' SmallInt';
   if LpDataType = ftFloat then
      sentence := 'ADD '+LpFieldName+' Float('+ IntToStr( LpSize ) +',0)';
   if LpDataType = ftDate then
      sentence := 'ADD '+LpFieldName+' Date';
   if LpDataType = ftTime then
      sentence := 'ADD '+LpFieldName+' Time';
   if LpDataType = ftDateTime then
      sentence := 'ADD '+LpFieldName+' TimeStamp';
   if sentence = '' then
      raise EDBUpdateErr.Create('Чֶ');
   if SQLSentence = '' then
      SQLSentence := sentence
   else
      SQLSentence := SQLSentence + ', ' + sentence;
   Result:=SQLSentence;//SQL
end;

//ָıɾֶ
function KillField(LpFieldName:string):String;//ɾеֶ
var
   SQLsentence : string;
begin
   if LpFieldName = '' then
      raise EDBUpdateErr.Create('ֶΪ');
   if Pos(' ', LpFieldName) <> 0 then
      raise EDBUpdateErr.Create('ֶвܺпոַ');
   if SQLSentence = '' then
      SQLSentence := 'DROP COLUMN ' + LpFieldName
   else
      SQLSentence := SQLSentence + ', DROP ' + LpFieldName;
   Result:=SQLSentence;
end;

//޸ıṹSQLִ
function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;//޸ıṹ
var
   AlterQueryTable:TQuery;
   Successed:Boolean;//ɹ
begin
   Successed:=False;
   AlterQueryTable:= TQuery.Create(nil);
   try
      try
         with AlterQueryTable do
         begin
            DataBaseName:=LpDataBaseName;//ݿ
            UniDirectional:=True;
            Active:=False;
            Sql.Clear;
            Sql.Add(LpSentence);
            ExecSQL;
            Successed:=True;
         end;
      except
         Successed:=False;
      end;
   finally
      AlterQueryTable.Free;
      if successed then
         Result:=True
      else
         Result:=False;
   end;
end;

//޸ġӡɾṹʱSQL
function GetSQLSentence(LpTableName,LpSQLsentence:string): string;
begin
  Result := 'ALTER TABLE "'+ LpTableName +'" ' + LpSQLSentence + ';';
end;


//============================================================//
//======================Ͻƺ======================//
//============================================================//

//ַתʮ
function StrToHex(AStr: string): string;
var
   I : Integer;
//   Tmp: string;
   begin
      Result := '';
      For I := 1 to Length(AStr) do
      begin
         Result := Result + Format('%2x', [Byte(AStr[I])]);
      end;
      I := Pos(' ', Result);
      While I <> 0 do
      begin
         Result[I] := '0';
         I := Pos(' ', Result);
      end;
end;

//ʮתַ
function HexToStr(AStr: string): string;
var
   I : Integer;
   CharValue: Word;
   begin
   Result := '';
   for I := 1 to Trunc(Length(Astr)/2) do
   begin
      Result := Result + ' ';
      CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
      Result[I] := Char(CharValue);
   end;
end;

function TransChar(AChar: Char): Integer;
begin
   if AChar in ['0'..'9'] then
      Result := Ord(AChar) - Ord('0')
   else
      Result := 10 + Ord(AChar) - Ord('A');
   end;

//============================================================//
//============================================//
//============================================================//

// Min..Max֮
function TrimInt(Value, Min, Max: Integer): Integer; overload;
begin
  if Value > Max then
    Result := Max
  else if Value < Min then
    Result := Min
  else
    Result := Value;
end;

// 0..255֮
function IntToByte(Value: Integer): Byte; overload;
asm
        OR     EAX, EAX
        JNS    @@Positive
        XOR    EAX, EAX
        RET

@@Positive:
        CMP    EAX, 255
        JBE    @@OK
        MOV    EAX, 255
@@OK:
end;

// TRectꡢ
procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
begin
  x := Rect.Left;
  y := Rect.Top;
  Width := Rect.Right - Rect.Left;
  Height := Rect.Bottom - Rect.Top;
end;

// ȽRect
function RectEqu(Rect1, Rect2: TRect): Boolean;
begin
  Result := (Rect1.Left = Rect2.Left) and (Rect1.Top = Rect2.Top) and
    (Rect1.Right = Rect2.Right) and (Rect1.Bottom = Rect2.Bottom);
end;

// TSize
function EnSize(cx, cy: Integer): TSize;
begin
  Result.cx := cx;
  Result.cy := cy;
end;

// RectĿ
function RectWidth(Rect: TRect): Integer;
begin
  Result := Rect.Right - Rect.Left;
end;

// Rectĸ߶
function RectHeight(Rect: TRect): Integer;
begin
  Result := Rect.Bottom - Rect.Top;
end;

// жϷΧ
function InBound(Value: Integer; Min, Max: Integer): Boolean;
begin
  Result := (Value >= Min) and (Value <= Max);
end;

// 
procedure CnSwap(var A, B: Byte); overload;
var
  Tmp: Byte;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Integer); overload;
var
  Tmp: Integer;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Single); overload;
var
  Tmp: Single;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

procedure CnSwap(var A, B: Double); overload;
var
  Tmp: Double;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

// ʱ
procedure Delay(const uDelay: DWORD);
var
  n: DWORD;
begin
  n := GetTickCount;
  while ((GetTickCount - n) <= uDelay) do
    Application.ProcessMessages;
end;

// Win9Xȷ
procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
const
  FREQ_SCALE = $1193180;
var
  Temp: WORD;
begin
  Temp := FREQ_SCALE div Freq;
  asm
    in al,61h;
    or al,3;
    out 61h,al;
    mov al,$b6;
    out 43h,al;
    mov ax,temp;
    out 42h,al;
    mov al,ah;
    out 42h,al;
  end;
  Sleep(Delay);
  asm
    in al,$61;
    and al,$fc;
    out $61,al;
  end;
end;

// ʾWin32 ApiнϢ
procedure ShowLastError;
var
  ErrNo: Integer;
  Buf: array[0..255] of Char;
begin
  ErrNo := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, $400, Buf, 255, nil);
  if Buf = '' then StrCopy(@Buf, PChar(SUnknowError));
  MessageBox(Application.Handle, PChar(string(Buf) + #10#13 +
    SErrorCode + IntToStr(ErrNo)),
    SCnInformation, MB_OK + MB_ICONINFORMATION);
end;

//Font.StyleдINIļ
function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;
var
  Mystyle : string;
  Myini : Tinifile;
begin
  Mystyle := '[';
  if fsBold in FS then MyStyle := MyStyle + 'fsBold';
  if fsItalic in FS then
  if MyStyle = '[' then
    MyStyle := MyStyle + 'fsItalic'
  else
    MyStyle := MyStyle + ',fsItalic';
  if fsUnderline in FS then
    if MyStyle = '[' then
       MyStyle := MyStyle + 'fsUnderline'
    else
       MyStyle := MyStyle + ',fsUnderline';
  if fsStrikeOut in FS then
    if MyStyle = '[' then
      MyStyle := MyStyle + 'fsStrikeOut'
    else
      MyStyle := MyStyle + ',fsStrikeOut';
  MyStyle := MyStyle + ']';
  if write then
  begin
    Myini := TInifile.Create(inifile);
    Myini.WriteString('FontStyle', 'style', MyStyle);
    Myini.free;
  end;
  Result := MyStyle;
end;

//INIļжȡFont.Styleļ
function readFontStyle(inifile: string): TFontStyles;
var
  MyFontStyle : TFontStyles;
  MyStyle : string;
  Myini : Tinifile;
begin
  MyFontStyle := [];
  Myini := TInifile.Create(inifile);
  Mystyle := Myini.ReadString('Fontstyle', 'style', '[]');
  if pos('fsBold', Mystyle) > 0 then MyFontStyle := MyFontStyle +   [fsBold];
  if Pos('fsItalic', MyStyle) > 0 then MyFontStyle := MyFontStyle + [fsItalic];
  if Pos('fsUnderline', MyStyle) > 0 then
    MyFontStyle := MyFontStyle + [fsUnderline];
  if Pos('fsStrikeOut', MyStyle) > 0 then
    MyFontStyle := MyFontStyle + [fsStrikeOut];
  MyIni.free;
  Result := MyFontStyle;
end;

//*ȡTMemo ؼǰкϢTpoint
//function ReadCursorPos(SourceMemo: TMemo): TPoint;
function ReadCursorPos(SourceMemo: TMemo): string;
var
   //   Point: TPoint;
   X,Y:integer;
begin
//   point.y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);
//   point.x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
   y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);
   x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,y,0);
   Result := ':'+inttostr(y+1)+' '+':'+inttostr(x+1);
end;

//*TmemoؼܷUndo
function CanUndo(AMemo: TMemo): Boolean;
begin
   Result :=AMemo.Perform(EM_CANUNDO, 0, 0)<>0;
end;

//* ʵUndo
procedure Undo(Amemo: Tmemo);
begin
   Amemo.Perform(EM_UNDO, 0, 0);
end;

//* ʵComBoBoxԶ
procedure AutoListDisplay(ACombox:TComboBox);
begin
   SendMessage(ACombox.handle, CB_SHOWDROPDOWN, Integer(True), 0);
end;

//* СдתΪд
function UpperMoney(small:real):string;
var
   SmallMonth,BigMonth:string;
   wei1,qianwei1:string[2];
   qianwei,dianweizhi,qian:integer;
   ObjSmall:real;
begin
   {------- ޸Ĳֵȷ -------}
   ObjSmall:=Abs(small);
   qianwei:=-2;{СλãҪĻҲԸĶ-2ֵ}
   Smallmonth:=formatfloat('0.00',ObjSmall);{תɻʽҪĻСӶ༸}
   {---------------------------------}
   dianweizhi :=pos('.',Smallmonth);{Сλ}
   for qian:=length(Smallmonth) downto 1 do{ѭСдҵÿһλСдұλõ}
   begin
      if qian<>dianweizhi then{ĲСͼ}
         begin
            case strtoint(copy(Smallmonth,qian,1)) of{λϵתɴд}
            1:wei1:='Ҽ';
            2:wei1:='';
            3:wei1:='';
            4:wei1:='';
            5:wei1:='';
            6:wei1:='½';
            7:wei1:='';
            8:wei1:='';
            9:wei1:='';
            0:wei1:='';
            end;
            case qianwei of{жϴдλãԼreal͵ֵ}
            -3:qianwei1:='';
            -2:qianwei1:='';
            -1:qianwei1:='';
            0 :qianwei1:='Ԫ';
            1 :qianwei1:='ʰ';
            2 :qianwei1:='';
            3 :qianwei1:='ǧ';
            4 :qianwei1:='';
            5 :qianwei1:='ʰ';
            6 :qianwei1:='';
            7 :qianwei1:='ǧ';
            8 :qianwei1:='';
            9 :qianwei1:='ʮ';
            10:qianwei1:='';
            11:qianwei1:='ǧ';
            end;
            inc(qianwei);
            if Small<0 then
               BigMonth :=''+wei1+qianwei1+BigMonth {ϳɴд}
            else
               BigMonth :=wei1+qianwei1+BigMonth {ϳɴд}
         end;
   end;
   Result:=BigMonth;
end;

//ϵͳʱ
function Myrandom(Num: Integer): integer;
var
   T: _SystemTime;
   X: integer;
   I: integer;
begin
   Result := 0;
   If Num = 0 then Exit;;
      GetSystemTime(T);
      X := Trunc(T.wMilliseconds/10) * T.wSecond * 1231;
      X := X + random(1);
      if X<>0 then
         X := -X;
      X := Random(X);
      X := X mod num;
      for I := 0 to X do
         X := Random(Num);
      Result := X;
end;

//뷨
procedure OpenIME(ImeName: string);
var
  i: integer;
  MyHKL: hkl;
begin
  if ImeName <> '' then begin
    if Screen.Imes.Count <> 0 then begin
      i := Screen.Imes.IndexOf(ImeName);
      if i >= 0 then MyHKL := hkl(Screen.Imes.Objects[i]);
      ActivateKeyboardLayout(MyHKL, KLF_ACTIVATE);
    end;
  end;
end;

//ر뷨
procedure CloseIME;
var
  MyHKL: hkl;
begin
  MyHKL := GetKeyboardLayout(0);
  if ImmIsIme(MyHKL) then
    ImmSimulateHotKey(Application.Handle, IME_CHOTKEY_IME_NONIME_TOGGLE);
end;

//뷨
procedure ToChinese(hWindows: THandle; bChinese: boolean);
begin
  if ImmIsIME(GetKeyboardLayOut(0)) <> bChinese then
    ImmSimulateHotKey(hWindows, IME_THotKey_IME_NonIME_Toggle);
end;

//ݱ
procedure BackUpData(LpBackDispMessTitle:String);
var
   i,j:integer;
   Source,Dest:array[0..200]of char;
   s1:string;
   Lp:_SHFILEOPSTRUCTA;
   Success:Integer;
begin
   if MessageBox(Application.Handle,' ȷҪ','ѯʴ',4+32+256)=6 then
   begin
      with LP do
      begin
    		Lp.wnd:=Application.Handle;
        	wFunc:=FO_COPY;
         s1:='DATA\*.*';
         i:=Length(s1);
         StrCopy(Source,PChar(s1));
         Source[i]:=#0;
         Source[i+1]:=#0;
         Source[i+2]:=#0;
         pFrom:=Source;
         s1:='BACKUP';
         j:=Length(s1);
         StrCopy(Dest,PChar(s1));
         Dest[j]:='\';
         Dest[j+1]:=#0;
         Dest[j+2]:=#0;
         Dest[j+3]:=#0;
         pTo:=Dest;
        	fFlags:=FOF_ALLOWUNDO;
         fAnyOperationsAborted:=False;
         lpszProgressTitle:=PChar(LpBackDispMessTitle);
      end;
    	Success:=SHFileOperation(LP);
      case Success of
         0:
            MessageBox(Application.Handle,' ѱ ','ʾ',0+48);
         117:
            MessageBox(Application.Handle,Pchar(' δ'+ExtractFilePath(Application.ExeName)+'BACKUPĿ¼Բݱ '),'ʾ',0+16)
         else
            MessageBox(Application.Handle,' ڱݵĹбû;ж ','ʾ',0+16);
      end;
   end;
end;




////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//                          ļжȡAdoִ                           //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////
function GetConnectionString(DataBaseName:string):string;
var FileStringList:Tstringlist;
    TempString: ansistring;
    TheReg:TRegistry;KeyName,fAppPath:string;
    i:Integer;
begin

  TheReg:=TRegistry.Create;

  try
    TheReg.RootKey:=HKEY_LOCAL_MACHINE;
    KeyName:='Software\ɹϵͳ';
    if TheReg.OpenKey(KeyName,False) then
      fAppPath:=TheReg.ReadString('ApplicationPath');
  finally
    TheReg.Free;
  end;

  FileStringList:=Tstringlist.Create;
  //жconnection.txtǷ,ھ͵
  if FileExists(fAppPath+'\connection.txt') then
     FileStringList.LoadFromFile(fAppPath+'\connection.txt')
  else
  begin

      application.MessageBox('ϵͳĿ¼ûм⵽ļ(connection.txt)޷ϵͳ','ʾ',MB_IconError+mb_ok);

      Result:='';
      FileStringList.Free;
      Exit;
  end;
  //һýд
  TempString:='';
  for i:=0 to FileStringList.Count-1 do
  begin
    TempString:=TempString+FileStringList.strings[i];
  end;

  {ָƵݿ}
  TempString:=Replace(TempString,'DataBaseName',DataBaseName,False);

  Result:=TempString;

end;


{------------------------------------------------------------------------------}
{function GetRemoteServerNameԶ̷Ļ}
function GetRemoteServerName:string;
var iniServer:TIniFile;
    TheReg:TRegistry;KeyName,fAppPath,RServerName:string;
begin

  TheReg:=TRegistry.Create;

  try
    TheReg.RootKey:=HKEY_LOCAL_MACHINE;
    KeyName:='Software\ɹϵͳ';

    if TheReg.OpenKey(KeyName,False) then
      fAppPath:=TheReg.ReadString('ApplicationPath');
  finally
    TheReg.Free;
  end;

  {Զ̷}
  try
    iniServer:=TIniFile.Create(fAppPath+'\RemoteServerName.ini');
    with iniServer do
      RServerName:=ReadString('Option','RServerName','');
    iniServer.Free;
  except
    raise exception.Create('δҵComõϢļʼʧܡ');
  end;
  Result:=RServerName;

end;



initialization
  WndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE);
end.

