全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1317
推到 Plurk!
推到 Facebook!

Memory Leak ...

答題得分者是:william
seaturn99
版主


發表:69
回覆:427
積分:214
註冊:2003-08-25

發送簡訊給我
#1 引用回覆 回覆 發表時間:2004-07-19 16:23:32 IP:210.68.xxx.xxx 未訂閱
請教一下各位先進 :    我自行設計了一個物件,功能是做 Log 用,我在程式裡使用動態 Create/Free 的方式,不過我發現 Memory Leak 很嚴重,利用一個跑 10000 次的迴圈,可以看到記憶體耗損甚鉅..    不過我從自己的 Code 看不太出來有什麼是該 Free 沒有 Free 的... 資料庫為 MSSQL ,若只執行 LogToFile ,依然會有 Memory Leak ..    Code 如下 :
    unit MySystemLog;    interface    uses Classes, SysUtils, ADODB, Dialogs;    type
  TSystemLog = class(TObject)
  private
    FConnection: TADOConnection;
    FOwner, FDirectory: string;
  public
    constructor Create;
    destructor Destory;
    function GenerateFileNameByDate: string;
    procedure ConnectToADODB(const AServerName, AUserID, APWD: string);
    procedure SystemLog(const Code: integer; const LogMsg: string);
    procedure LogToFile(const AFileName: string; const ACode: integer; const
      ALogMsg: string);
    property DBOwner: string read FOwner write FOwner;
    property Directory: string read FDirectory write FDirectory;
  end;    implementation    uses xFiles;    constructor TSystemLog.Create;
begin
  inherited;
  FConnection := TADOConnection.Create(nil);
  FOwner := 'DBOwner';
  FDirectory := '.\Log\';
end;    destructor TSystemLog.Destory;
begin
  FConnection.Close;
  FreeAndNil(FConnection);
  inherited;
end;    procedure TSystemLog.ConnectToADODB(const AServerName, AUserID, APWD:
  string);
begin
  FConnection.ConnectionString :=
    format('Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s;Initial Catalog=Vate;Data Source=%s', [APWD, AUserID, AServerName]);
  FConnection.Mode := cmReadWrite;
  FConnection.IsolationLevel := ilReadUncommitted;
  FConnection.LoginPrompt := false;
  FConnection.KeepConnection := true;
  FConnection.Open;
end;    procedure TSystemLog.SystemLog(const Code: integer; const LogMsg:
  string);
var
  Query: TADOQuery;
begin
  try
    Query := TADOQuery.Create(nil);
    Query.Connection := FConnection;
    Query.SQL.Text :=
      format('INSERT INTO [%s].[SystemLog](Code,Message,LogType_Code,Lv) VALUES(%d,:Message,1,1)',
      [FOwner, Code]);
    Query.Parameters.ParamByName('Message').Value := LogMsg;
    Query.ExecSQL;
  finally
    Query.Close;
    FreeAndNil(Query);
  end;
end;    procedure TSystemLog.LogToFile(const AFileName: string; const ACode: integer;
  const ALogMsg: string);
var
  fp: TextFile;
  LogFileName: string;
begin
  if not DirectoryExists(FDirectory) then
    raise Exception.CreateFmt('Log Directory : %s not found', [FDirectory]);      LogFileName := PathWithSlash(FDirectory)   AFileName;
  try
    AssignFile(fp, LogFileName);        if not FileExists(LogFileName) then
      Rewrite(fp)
    else
      Append(fp);        if (ACode > 0) and (ACode <> ACTION_SUCCESS) then
      Writeln(fp, format('SYSTEM ERROR (%d) : %s', [ACode, ALogMsg]))
    else
      Writeln(fp, ALogMsg);        Flush(fp);
    CloseFile(fp);
  except
    raise Exception.Create('Open Log File Error!!');
  end;
end;    function TSystemLog.GenerateFileNameByDate: string;
begin
  Result := FormatDateTime('yyyymmdd', Now);
end;    end.    
測試 Code :
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  procedure SaveLog;
  var
    SystemLog: TSystemLog;
  begin
    try
      SystemLog := TSystemLog.Create;
      SystemLog.ConnectToADODB('Test', 'DBOwner', '1111');
      SystemLog.Directory := 'C:\Temp\Log';          SystemLog.LogToFile(SystemLog.GenerateFileNameByDate   '.log',
        -1,
        'Test Log to File');          SystemLog.SystemLog(-1, 'Test Log to DB');
    finally
      FreeAndNil(SystemLog);
    end;
  end;
begin
  for i := 1 to 100000 do
    SaveLog;
end;    
---- 我只會兩件事,這也不會,那也不會 眼見不一定為真 ---- 發表人 - SouthWind 於 2004/07/19 16:50:45
william
版主


發表:66
回覆:2535
積分:3048
註冊:2002-07-11

發送簡訊給我
#2 引用回覆 回覆 發表時間:2004-07-19 16:48:17 IP:147.8.xxx.xxx 未訂閱
No time to check it line by line... but:
....
    destructor Destory; override;
....
發表人 - william 於 2004/07/19 16:49:15
seaturn99
版主


發表:69
回覆:427
積分:214
註冊:2003-08-25

發送簡訊給我
#3 引用回覆 回覆 發表時間:2004-07-19 18:45:03 IP:220.130.xxx.xxx 未訂閱
引言: No time to check it line by line... but:
....
    destructor Destory; override;
....
感謝 william 版大,一句話就命中了... 我的 destructor Destory; 拼錯了...哈哈,結果父輩的 Class 沒有執行到 Destroy ,當然就 Memory Leak 了... 真是感到十分的丟臉....< >< > ---- 我只會兩件事,這也不會,那也不會 眼見不一定為真 ----
系統時間:2024-05-17 3:38:55
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!