程序运行的时候报错了,看日志堆栈追踪仿佛是一个日志类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: 76This 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: TLogThrThe allocation number was: 40700The 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  ? €  €  €  €  €  €  €  €  .  .  .  .  .  .  .  .
.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .

解决方案 »

  1.   

    日志类源码,我这个类是想实现多线程写同一个文件的://日志处理单元unit uLog;interfaceuses
      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;implementationuses
      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.
      

  2.   

    又报了个新错,另外调试的时候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: 72This 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: TLogThrThe allocation number was: 30201The 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  ? €  €  €  €  €  €  €  €  €  €  €  €  .  .  .  .  .  .  .  .
    .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
    .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
      

  3.   

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

  4.   

    线程创建了没有释放,把线程的FreeOnTerminated置为True。另外从代码上楼主用线程来写日志有点多余,不但没加快速度,反而影响了速度。
      

  5.   

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