熟悉FastMM的进来看下

[__Ray__]

程序运行的时候报错了，看日志堆栈追踪仿佛是一个日志类uLog.pas有问题，我把源码贴出来大家帮我分析下我这个日志类有什么问题：

--------------------------------2011/5/24 14:07:25--------------------------------
FastMM has detected an error during a GetMem operation. FastMM detected that a block has been modified after being freed.

Modified byte offsets (and lengths): 14(1)

The previous block size was: 76

This block was previously allocated by thread 0x10B8, and the stack trace (return addresses) at the time was:
402DC0 [CPortCtl][CPortCtl][OffBitmaps]
403F97 [System][System][TObject.NewInstance]
404372 [System][System][@ClassCreate]
427D29 [Classes][Classes][TThread.Create]
40524A [System][System][@LStrCatN]
4B013A [uLog.pas][uLog][uLog_log][88]
4B348C [uComView.pas][uComView][TfraComView.FileLog][1127]
4B3505 [uComView.pas][uComView][TfraComView.AllLog][1133]
4B3347 [uComView.pas][uComView][TfraComView.WriteCmd][1089]
4B2642 [uComView.pas][uComView][AutoSetRate][837]
4B28EC [uComView.pas][uComView][TfraComView.InitModem][892]

The block was previously used for an object of class: TLogThr

The allocation number was: 40700

The block was previously freed by thread 0x1540, and the stack trace (return addresses) at the time was:
402DEB [CPort][CPort][@FreeMem]
403FB5 [System][System][TObject.FreeInstance]
4043BD [System][System][@ClassDestroy]
427E43 [Classes][Classes][TThread.Destroy]
403FFB [System][System][TObject.Free]
427CF6 [Classes][Classes][ThreadProc]
404E06 [System][System][ThreadWrapper]
7C80B729 [Unknown function at GetModuleFileNameA]

The current thread ID is 0x10B8, and the stack trace (return addresses) leading to this error is:
40A7C8 [FastMM4.pas][FastMM4][DebugGetMem][6843]
402DC0 [CPortCtl][CPortCtl][OffBitmaps]
403F97 [System][System][TObject.NewInstance]
404372 [System][System][@ClassCreate]
427D29 [Classes][Classes][TThread.Create]
40524A [System][System][@LStrCatN]
4B013A [uLog.pas][uLog][uLog_log][88]
4B348C [uComView.pas][uComView][TfraComView.FileLog][1127]
4B3505 [uComView.pas][uComView][TfraComView.AllLog][1133]
4B3347 [uComView.pas][uComView][TfraComView.WriteCmd][1089]
4B2642 [uComView.pas][uComView][AutoSetRate][837]

Current memory dump of 256 bytes starting at pointer address 7FF44620:
8C BC 4D 00 80 80 80 80 80 80 80 80 80 80 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80
80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80
80 80 80 80 80 80 80 80 80 80 80 80 DF 96 72 FE 80 80 80 80 80 80 80 80 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
? ? M . € € € € € € € € € € . € € € € € € € € € € € € € € € € €
€ € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € €
€ € € € € € € € € € € € ? ? r ? € € € € € € € € . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

[__Ray__]

日志类源码，我这个类是想实现多线程写同一个文件的：

//日志处理单元

unit uLog;

interface

uses
  SysUtils, IniFiles, Windows, Classes;

type
  TLogFunc = procedure(const S: string);
  TLogType = (sslog, ssCommlog, ssSmsLog);

  TLogThr = class(TThread)
  private
    FLogFunc: TLogFunc;
    FText: string;
    FlogType: TLogType;
  protected
    procedure Execute; override;
  public
    property Func: TLogFunc read FLogFunc write FLogFunc;
    property Text: string read FText write FText;
    property logType: TLogType read FlogType write FlogType;
  end;

  //TLog = class
  //private
    //class
    procedure uLog_Init;   //初始化
  //public
    //class
    procedure uLog_log(const S: string);
    //class
    procedure uLog_Commlog(const S: string);
    //class
    procedure uLog_SmsLog(const S: string);
  //end;

  procedure uLog_logFunc(const S: string);
  procedure uLog_CommlogFunc(const S: string);
  procedure uLog_SmsLogFunc(const S: string);

  function uLog_LogText(const S: string): string;
  procedure uLog_SetNewLogPath(const logPath: string);   //重新设置日志文件路径


var
  gLogFile, gCommLogFile, gSmsLogFile: TextFile;
  gOldLogFileName: string;     //普通日志文件名
  gOldCommLogFileName: string; //通讯日志文件名
  gOldSmsLogFileName: string;  //短信日志文件名

  gRootPath,gLogPath: string;

  logLock, CommLogLock, SmsLogLock: TRTLCriticalSection;

implementation

uses
  uConst;

{ TLog }

//格式化日志
function uLog_LogText(const S: string): string;
begin
  Result := StringReplace(StringReplace(S, #13#10, '\n' ,[rfReplaceAll]), #13, '\x0d', [rfReplaceALl]);
  Result := StringReplace(Result, #10, '\x0a', [rfReplaceALl]);
  Result := Format('%s: %s',[FormatDateTime(gConfig.DataFormat+' '+gConfig.TimeFormat, Now), Result]); //'dd/MM/yyyy hh:nn:ss'
end;

//重新设置日志文件路径
procedure uLog_SetNewLogPath(const logPath: string);
begin
  gLogPath := logPath;
  //造成文件名不一致，迫使日志函数重新定位路径------
  gOldLogFileName     := '1';
  gOldCommLogFileName := '1';
  gOldSmsLogFileName  := '1';
  //------------------------------------------------
end;


//class
procedure uLog_log(const S: string);    //TLog.
begin
  with TLogThr.Create(True) do
  begin
    Func := uLog_logFunc;
    Text := S;
    LogType := ssLog;
    Resume;
  end;
end;


//class
procedure uLog_Commlog(const S: string);    //TLog.
begin
  with TLogThr.Create(True) do
  begin
    Func := uLog_CommlogFunc;
    Text := S;
    LogType := ssCommLog;
    Resume;
  end;
end;



//class
procedure uLog_Smslog(const S: string);    //TLog.
begin
  with TLogThr.Create(True) do
  begin
    Func := uLog_SmslogFunc;
    Text := S;
    LogType := ssSmsLog;
    Resume;
  end;
end;

//自动找寻当日日志文件，新的一天开始会自动创建新文件(普通日志)
procedure uLog_logFunc(const S: string);
var
  logFileName: string;
begin
  try
    logFileName := FormatDateTime('yyyyMMdd',Now)+'.log';

    if logFileName <> gOldLogFileName then //程序启动 或 新的一天开始
    begin
      if gOldLogFileName<>'' then  //存在的昨日文件
        CloseFile(gLogFile);      //关闭昨日文件

      AssignFile(gLogFile, gLogPath+logFileName);
      gOldLogFileName := logFileName;

      if FileExists(gLogPath+logFileName) then
      begin
        Append(gLogFile);    //打开准备追加
        Writeln(gLogFile, '');        //另起一行
      end else
        ReWrite(gLogFile);  //覆盖已存在的文件
    end;

    if S <> '' then
      Writeln(gLogFile, uLog_LogText(S));     //格式化日志
  except
    //on e:exception do
    //  System.Writeln(e.Message);
  end;
end;

//自动找寻当日日志文件，新的一天开始会自动创建新文件(通讯日志)
procedure uLog_CommlogFunc(const S: string);
var
  logFileName: string;
begin
  try
    logFileName := FormatDateTime('yyyyMMdd',Now)+'.comm.log';

    if logFileName <> gOldCommLogFileName then //程序启动 或 新的一天开始
    begin
      if gOldCommLogFileName<>'' then  //存在的昨日文件
        CloseFile(gCommLogFile);      //关闭昨日文件

      AssignFile(gCommLogFile, gLogPath+logFileName);
      gOldCommLogFileName := logFileName;

      if FileExists(gLogPath+logFileName) then
      begin
        Append(gCommLogFile);    //打开准备追加
        Writeln(gCommLogFile, '');        //另起一行
      end else
        ReWrite(gCommLogFile);  //覆盖已存在的文件
    end;

    if S <> '' then
      Writeln(gCommLogFile, uLog_LogText(S));     //格式化日志
  except
    //on e:exception do
    //  System.Writeln(e.Message);
  end;
end;

//自动找寻当日日志文件，新的一天开始会自动创建新文件(短信日志)
procedure uLog_SmsLogFunc(const S: string);
var
  logFileName: string;
begin
  try
    logFileName := FormatDateTime('yyyyMMdd',Now)+'.sms.log';

    if logFileName <> gOldSmsLogFileName then //程序启动 或 新的一天开始
    begin
      if gOldSmsLogFileName<>'' then  //存在的昨日文件
        CloseFile(gSmsLogFile);      //关闭昨日文件

      AssignFile(gSmsLogFile, gLogPath+logFileName);
      gOldSmsLogFileName := logFileName;

      if FileExists(gLogPath+logFileName) then
      begin
        Append(gSmsLogFile);    //打开准备追加
        Writeln(gSmsLogFile, '');        //另起一行
      end else
        ReWrite(gSmsLogFile);  //覆盖已存在的文件
    end;

    if S <> '' then
      Writeln(gSmsLogFile, uLog_LogText(S));     //格式化日志
  except
    //on e:exception do
    //  System.Writeln(e.Message);
  end;
end;

//从配置读取日志路径
//class
procedure uLog_Init;     //TLog.
var
  ini: TIniFile;
  fileName: string;
  h: Integer;
begin
  gRootPath := ExtractFilePath(ParamStr(0));
  gOldLogFileName := '';
  gOldCommLogFileName := '';
  
  fileName := gRootPath+FILE_CONFIG;
  if not FileExists(fileName) then //创建配置文件
  begin
    h := FileCreate(fileName);
    FileClose(h);
  end;

  ini := TIniFile.Create(fileName);
  with ini do
  try
    gLogPath := ReadString('LOG', 'LogPath', gRootPath +'log\');
    if not DirectoryExists(gLogPath) then
      gLogPath := gRootPath +'log\';
  finally
    Free;
  end;

  //创建日志文件夹
  if not DirectoryExists(gLogPath) then
    if not CreateDir(gLogPath) then
      raise Exception.Create('Cann''t create dierctory:'+gLogPath);
end;

{ TLogThr }

procedure TLogThr.Execute;
begin
  FreeOnTerminate := True;
  if Assigned(FLogFunc) then
  begin
    if FLogType = sslog then
      EnterCriticalSection(logLock)
    else if FLogType = ssCommlog then
      EnterCriticalSection(CommlogLock)
    else if FLogType = ssSmslog then
      EnterCriticalSection(SmslogLock);

    try
      FLogFunc(FText);
    finally
      if FLogType = sslog then
        LeaveCriticalSection(logLock)
      else if FLogType = ssCommlog then
        LeaveCriticalSection(CommlogLock)
      else if FLogType = ssSmslog then
        LeaveCriticalSection(SmslogLock);
    end;

  end;
end;

initialization
  InitializeCriticalSection(logLock);
  InitializeCriticalSection(CommLogLock);
  InitializeCriticalSection(SmsLogLock);

  //TLog.
  uLog_Init;
  //初始化---------------------
  //TLog.
  uLog_log('');
  //TLog.
  uLog_Commlog('');
  //TLog.
  uLog_SmsLog('');
  ////

finalization
  if gOldLogFileName<>'' then
    CloseFile(gLogFile);
  if gOldCommLogFileName<>'' then
    CloseFile(gCommLogFile);
  if gOldSmsLogFileName<>'' then
    CloseFile(gSmsLogFile);

  DeleteCriticalSection(logLock);
  DeleteCriticalSection(CommLogLock);
  DeleteCriticalSection(SmsLogLock);
end.

[__Ray__]

又报了个新错，另外调试的时候DELPHI弹出Out of memory错误，错误代码行指向的是：with TLogThr.Create(True) do，这句怎么会Out of memory呢真是不明白

--------------------------------2011/5/24 14:58:11--------------------------------
FastMM has detected an error during a GetMem operation. FastMM detected that a block has been modified after being freed.

Modified byte offsets (and lengths): 14(1)

The previous block size was: 72

This block was previously allocated by thread 0x11E8, and the stack trace (return addresses) at the time was:
402DC0 [CPortCtl][CPortCtl][OffBitmaps]
403F97 [System][System][TObject.NewInstance]
404372 [System][System][@ClassCreate]
427D29 [Classes][Classes][TThread.Create]
40524A [System][System][@LStrCatN]
4B013A [uLog.pas][uLog][uLog_log][88]
4B34BC [uComView.pas][uComView][TfraComView.FileLog][1127]
4B3535 [uComView.pas][uComView][TfraComView.AllLog][1133]
4B3377 [uComView.pas][uComView][TfraComView.WriteCmd][1089]
4B2672 [uComView.pas][uComView][AutoSetRate][837]
4B291C [uComView.pas][uComView][TfraComView.InitModem][892]

The block was previously used for an object of class: TLogThr

The allocation number was: 30201

The block was previously freed by thread 0xF2C, and the stack trace (return addresses) at the time was:
402DEB [CPort][CPort][@FreeMem]
403FB5 [System][System][TObject.FreeInstance]
4043BD [System][System][@ClassDestroy]
427E43 [Classes][Classes][TThread.Destroy]
403FFB [System][System][TObject.Free]
427CF6 [Classes][Classes][ThreadProc]
404E06 [System][System][ThreadWrapper]
7C80B729 [Unknown function at GetModuleFileNameA]

The current thread ID is 0x11E8, and the stack trace (return addresses) leading to this error is:
40A7C8 [FastMM4.pas][FastMM4][DebugGetMem][6843]
402DC0 [CPortCtl][CPortCtl][OffBitmaps]
4BE167 [jpeg][jpeg][_malloc]
4C0766 [jpeg][jpeg][@jpeg_get_small]
4C06B7 [jpeg][jpeg][@jinit_memory_mgr]
4BF6BB [jpeg][jpeg][jpeg_CreateDecompress]
4BE607 [jpeg][jpeg][InitDecompressor]
4BEDD3 [jpeg][jpeg][TJPEGImage.GetBitmap]
42C8DD [Graphics][Graphics][TCanvas.CreateBrush]
4BEBE4 [jpeg][jpeg][TJPEGImage.Draw]
42C374 [Graphics][Graphics][TCanvas.StretchDraw]

Current memory dump of 256 bytes starting at pointer address 7FF44540:
8C BC 4D 00 80 80 80 80 80 80 80 80 80 80 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80
80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80
80 80 80 80 80 80 80 80 BA C4 72 FE 80 80 80 80 80 80 80 80 80 80 80 80 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
? ? M . € € € € € € € € € € . € € € € € € € € € € € € € € € € €
€ € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € €
€ € € € € € € € ? ? r ? € € € € € € € € € € € € . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

[jayqiang]

有点疑问线程启动后开始写文件，可是线程什么时候销毁呢？
我从你给的代码中没有看到线程销毁的代码哦！
如果没有销毁的话线程一直都在写那个文件，以线程的速度用不了多久就会出现Out of memory啦！

[SQLDebug_Fan]

线程创建了没有释放，把线程的FreeOnTerminated置为True。

另外从代码上楼主用线程来写日志有点多余，不但没加快速度，反而影响了速度。

[__Ray__]

FreeOnTerminated有设置啊，在线程的Execute方法第一行就定义了，我之所以用线程呢是考虑到多个线程写同一个日志文件的需要，因为我可能在主线程中需要写日志，也可能在其他线程中也需要写日志，日志是同一个文件，如果不用线程同步，直接就写入的话就可能引起冲突。

[SQLDebug_Fan]

用单个线程来写日志，其它的都通过这个线程来写，或者把写日志的函数加锁。