Delphi：ADOConnection連接SQLServer自動斷網問題解決

===============================

解決方法一：異常時關閉連接，WinXP，win7 32位大部分情況都是起作用的，不過在有些windows操作系統下（如家庭版）不起作用，不知為何？

===============================

 

try

//執行sql操作

except

AdoConnection.close;//出現異常時關閉連接，在執行sql語句時會自動打開連接，從而實現斷線重連

end;

 

 

===============================

解決方法二：ADO控件動態創建，獨立設置連接字符串，為了避免連接不上時界面卡死，可以考慮放到線程中執行。

推薦，親測有效

===============================

unit untMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  IniFiles, ExtCtrls, DB, ADODB,ActiveX;

type
  TFrmMain = class(TForm)
    Timer2: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure getXXData();

  end;
  //ADO連接獲取數據線程
  TAdoThread = class(TThread)
  protected
    procedure execute; override;
  end;
var
  FrmMain: TFrmMain;
  ConString: string;
  { 初始化臨界區CS變量 }
  CS: TRTLCriticalSection;
implementation

uses untabout;

{$R *.dfm}

{ TForm1 }{ 寫程序異常日志 }
procedure write_error_log(str: string);
var
  F: TextFile;
  mfile: string;
begin
  try
    //判斷保存日志文件的目錄是否存在
    if not DirectoryExists(ExtractFilePath(ParamStr(0)) + 'log') then
      MkDir(ExtractFilePath(ParamStr(0)) + 'log');

    //按日期及時間設定保存日志的文件名
    mfile := ExtractFilePath(ParamStr(0)) + 'log\ErrLog_' + formatdatetime('yyyy-mm-dd', now) + '.txt';

    AssignFile(F,mfile);
    if not FileExists(mfile) then
      Rewrite(F);//如果文件不存在，則創建一個新的文件，並寫入
    Append(F); //追加寫入
    Writeln(F,str);//寫入並換行
    CloseFile(F);
  except
  end;
end;
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  { 清除線程CS變量 }
  DeleteCriticalSection(CS);
  Timer2.Enabled := False;
end;
procedure TFrmMain.FormShow(Sender: TObject);
var
  clientini: TIniFile; 
  db_server,user,password:string;
begin
  { 獲取ini配置信息}
  clientini := TIniFile.Create('.\config.ini');
  try
    if clientini<>nil then
    begin
      db_server := trim(clientini.readString('database','db_server',''));
      user := trim(clientini.readString('database','user','sa'));
      password := trim(clientini.readString('database','password',''));

      ConString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID='
         +user+';Password='+password+';Initial Catalog=Testdb;Data Source='+db_server;
    end;
  finally
    clientini.Free;
  end;
  InitializeCriticalSection(CS);//初始化線程臨界區

end;



procedure TFrmMain.Timer2Timer(Sender: TObject);
begin
  Timer2.Enabled := False;
  TAdoThread.Create(False);  
end;
procedure TFrmMain.getXXData();
var
  ADOStoredProc1: TADOStoredProc;
begin
  ADOStoredProc1 := TADOStoredProc.Create(nil);//動態創建ADO控件
  try
    try
      ADOStoredProc1.ConnectionString := ConString;//采用獨立的連接字符串
      if ADOStoredProc1.Active then
         ADOStoredProc1.Active := false;
      ADOStoredProc1.ProcedureName := 'GetData';
      ADOStoredProc1.Prepared := false;
      ADOStoredProc1.Parameters.Refresh;
      ADOStoredProc1.Prepared := true;
      ADOStoredProc1.ExecProc;
    except
      on E:Exception do
      begin
        write_error_log(FormatDateTime('yyyy-mm-dd hh:nn:ss',Now)
          + '>> 執行getXXData時發生異常!錯誤原因:'+E.Message
          );
      end;
    end
  finally
    ADOStoredProc1.Free;
  end; 
end;

{ TAdoThread }
procedure TAdoThread.execute;
begin
  inherited;
  FreeOnTerminate := True; //設置線程執行完成后自動釋放
  {進入線程臨界區}
  EnterCriticalSection(CS);
  try
    CoInitialize(nil); //線程中使用ADO，必須調用（需Uses ActiveX）
    {讀取HIS數據}
    FrmMain.getHisData(FrmMain.hasCharge);
    CoUninitialize;
  finally
    { 離開線程臨界區 }
    LeaveCriticalSection(CS);
  end;
  FrmMain.Timer2.Enabled := True;
end;

end.



============================
其他解決方法：未驗證，資料來自：
http://bbs.csdn.net/topics/390958648
============================
Win7上ADO連接SQLServer過幾十分鍾后自動斷網(被防火牆攔截等)問題終於解決了，困惑了很久
今天終於解決了！方法很簡單，和大家共享一下。

問題現象：ADO連接SQLServer過幾十分鍾后(有的過幾周)數據庫連接無緣無故斷開，
再做數據庫操作報錯“連接失敗”。實際上此時數據庫服務器可以ping通，
新創建其他ADO控件連接數據庫也沒問題。就這個ADO不行了。

問題分析：
剛開始想得比較簡單，只要創建個線程或者Timer時時判斷ADOConnecton1.Active屬性=false不得了么。但實際上因為后台原因
或者服務斷開再重連、被防火牆攔截等意外情況發生時ADOConnecton1.Active屬性仍然是true！無法判斷。
后來想到用ping，如果ping不通那就斷開了？！但是ping通了未必說明數據庫就能連通！ping無法判斷數據庫能否連通。
那么線程里面不斷執行個select GetDate 之類簡單SQL，如果失敗就判斷數據庫斷開行不行呢？顯然不行，
多用戶同時不斷連接數據庫對服務器壓力太大了，不可取。
后來網上查了很多材料，有人提出捕獲OleException的方法，既不創建線程和定時器判斷數據庫是否斷開，而是當用戶執行操作
發生Ole異常時捕獲它，如果是數據庫連接錯誤，那么恢復數據庫連接即可，我在他們代碼基礎上完善了一下，以下是實現代碼。

控件：

    Button1: TButton;
    ADOConnection1: TADOConnection;
    Button2: TButton;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ApplicationEvents1: TApplicationEvents;

代碼：

  uses ComObj;

{$R *.dfm}

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  I: integer;
begin
  //請執行如下命令或者其他方法強制產生數據庫連接斷開情況，以觸發如下異常。
  //net stop MsSqlServer
  //net start MsSqlServer
  if (E is EOleException) and ((E as EOleException).ErrorCode= -2147467259) then
  begin
    ADOConnection1.Connected := False;
    try
      ADOConnection1.Connected := True;
    except On E2: Exception do
    begin
      MessageDlg('重連數據庫發生錯誤：'#13 + E2.Message, mtError, [mbOK], 0);
    end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sSQL: string;
begin
  sSQL:= 'Provider=SQLOLEDB.1;Password=YourPassword;Persist Security Info=True;' +
    'User ID=sa;Initial Catalog=YourDatabase;Data Source=.';

  with ADOConnection1 do
  begin
    LoginPrompt:= false;
    Connected:= false;
    ConnectionString:= sSQL;
    Connected:= true;
  end;
  ShowMessage('ok');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with ADOQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from Test');
    Open;
  end;
end;