delphi 常用函数库(2)

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;
{* 用Ado连接SysBase数据库函数}
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;

//Ado与ODBC共同连接数据库函数
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 = 93180;
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,;
  and al,$fc;
  out ,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, 0, 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;
  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
      -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.

{▎ 觉得还一般 请关注 http://www.cdsunco.com/down.htm  还有更多的好东西   ▎}