多个线程写一个文件 ( 积分: 50 )

我用100个线程同时写1个文件，然后在写文件的代码用临界区进行锁定，但是还是会发生冲突，不知道为什么，难道需要用事件

设置正确的参数,指定文件以独占方式打开~~

try
FLock.Enter;
try
fStream:=TFileStream.Create(a.txt, fmOpenWrite);
finally
fstream.free;
end;
finally
FLock.Leave;
end;

我程序的基本结构就是这样的。创建1000个线程进行写文件，每个线程写完一次后SLEEP(100),运行一段时间后就出现打开文件失败的原因

r: TRTLCriticalSection;
...
r.InitializeCriticalSection;
r.EnterCriticalSection;
...
r.ExitCriticalSection;

楼主可否提供更多的代码，以供分析和学习。这个问题，小弟也一直没有试验成功。

你用的是同一个临界区吗？不会是1000个线程有1000个临界区吧？

看着也像有N个临界区。

1000个线程什么问题都没有
unit MThreadFile;
interface
uses
Classes, Windows;
Type
TSafeFileStream = class(TFileStream)
private
FLock : TRTLCriticalSection;
public
procedure Lock();
procedure UnLock();
constructor Create(const AFileName: string;
Mode: Word);
destructor Destroy;
override;
end;

implementation
{ TSafeFileStream }
constructor TSafeFileStream.Create(const AFileName: string;
Mode: Word);
begin
inherited Create(AFileName, Mode);
InitializeCriticalSection(FLock);
end;

destructor TSafeFileStream.Destroy;
begin
DeleteCriticalSection(FLock);
inherited Destroy;
end;

procedure TSafeFileStream.Lock;
begin
EnterCriticalSection(FLock);
end;

procedure TSafeFileStream.UnLock;
begin
LeaveCriticalSection(FLock);
end;

end.


////////////////////////////
var
TreadHandles : array[0..1000-1] of Cardinal;
ThreadEnd : Boolean = False;
function ThreadProc(FileStream: TSafeFileStream): BOOL;
stdcall;
var
Buf : string;
BufEnd : char;
begin
Buf := '1234567890';
BufEnd := '*';
while not ThreadEnddo
begin
FileStream.Lock();
try
FileStream.Write(PChar(Buf)^, Length(Buf));
FileStream.Write(BufEnd, SizeOf(char));
finally
FileStream.UnLock();
end;
end;
end;

procedure TForm1.btnEndClick(Sender: TObject);
var
I : Integer;
begin
ThreadEnd := True;
//等待任务结束
for I := 0 to 1000 - 1do
begin
WaitForSingleObject(TreadHandles, 1000);
end;
FFileStream.Free;
end;

procedure TForm1.btnStartClick(Sender: TObject);
var
I : Integer;
ThreadId : Cardinal;
begin
ThreadEnd := False;
FFileStream:= TSafeFileStream.Create('c:/a.txt', fmCreate);
for I := 0 to 1000 - 1do
TreadHandles := CreateThread(nil, 0, @ThreadProc, FFileStream, 0, ThreadId);
end;

我是写一个动态库的，代码如下:
unit DebugUt;
interface
uses Classes, SysUtils, Math, SyncObjs;
type
TDebug = class
private
FCircleFileCount: Integer;
FDebugFileName: string;
FDebugFilePath: string;
FCurrentFileId: Integer;
FLock: TCriticalSection;
protected
procedure ChangeFileStream;
public
Constructor Create;
Destructor Destroy;
override;
function InitDebug(ACircleFileCount: Integer;
ADebugFilePath, ADebugFileName: string): Integer;
procedure WriteDebug(ADebugStr: string);
procedure FreeDebug;

end;
implementation
{ TDebug }
procedure TDebug.ChangeFileStream;
var
fileStream: TFileStream;
begin

Inc(FCurrentFileID);
if FCurrentFileId > FCircleFileCount then
FCurrentFileId := 1;
fileStream := TFileStream.Create(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log', fmCreate);
try
finally
fileStream.Free;
end;
end;

constructor TDebug.Create;
begin
inherited;
FCurrentFileId := 1;
FCircleFileCount := 1;
FLock := TCriticalSection.Create;
end;

destructor TDebug.Destroy;
begin
FLock.Free;
inherited;
end;

procedure TDebug.FreeDebug;
begin

end;

function TDebug.InitDebug(ACircleFileCount: Integer;
ADebugFilePath,
ADebugFileName: string): Integer;
begin
result := -1;
try
FCircleFileCount := Max(ACircleFileCount, FCircleFileCount);
ForceDirectories(ADebugFilePath);
FDebugFilePath := ADebugFilePath;
FDebugFileName := ADebugFileName;
FCurrentFileId := 1;
except
exit;
end;
result := 0;
end;

procedure TDebug.WriteDebug(ADebugStr: string);
var
DebugStr: string;
filehandle: integer;
fileStream: TFileStream;
begin
try
FLock.Enter;
//检查当前文件是否存在
if not FileExists(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log') then
begin
fileHandle := FileCreate(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log');
FileClose( fileHandle);
end;
fileStream := TFileStream.Create(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log', fmOpenWrite);
try
DebugStr := DateTimeToStr(now) + '-->' + ADebugStr+ #13#10;
fileStream.Write(DebugStr[1], Length(DebugStr)) ;
//检查文件是否过大
if fileStream.Size > 100*1024 then
begin
ChangeFileStream;
end;

finally
fileStream.Free;
end;
finally
FLock.Leave;
end;
end;

end.

导出单元
unit ExportUt;
interface
uses DebugUt;
function InitDebug(ACircleFileCount: Integer;
ADebugFilePath, ADebugFileName: pChar): Integer;stdcall;
procedure WriteDebug(ADebugStr: string);stdcall;
procedure FreeDebug;stdcall;
exports
InitDebug,
WriteDebug,
FreeDebug;
var
MyDebug : TDebug;
implementation
function InitDebug(ACircleFileCount: Integer;
ADebugFilePath, ADebugFileName: pChar): Integer;
begin
MyDebug := TDebug.Create;
result := MyDebug.InitDebug(ACircleFileCount, ADebugFilePath, ADebugFileName);
end;

procedure WriteDebug(ADebugStr: string);
begin
MyDebug.WriteDebug(ADebugStr);
end;

procedure FreeDebug;
begin
MyDebug.FreeDebug;
MyDebug.Free;
end;
end.

测试程序如下
unit TestUt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DebugThread;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FArrayThread: Array of Cardinal;
public
{ Public declarations }
end;
function InitDebug(ACircleFileCount: Integer;
ADebugFilePath, ADebugFileName: pChar): Integer;
stdcall;external 'WriteDebug.dll' name 'InitDebug';
procedure WriteDebug(ADebugStr: string);
stdcall;
external 'WriteDebug.dll' name 'WriteDebug';
procedure FreeDebug;
stdcall;external 'WriteDebug.dll' name 'FreeDebug';
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
InitDebug(20, pChar(ExtractFilePath(Application.ExeName)), 'MyDebug');
SetLength(FArrayThread, 100);
for i:=0 to 99do
begin
FArrayThread := Cardinal(TWriteDebugThread.Create(False));
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
begin
for i:=0 to 99do
begin
TWriteDebugThread(FArrayThread).Terminate;
WaitForSingleObject(FArrayThread, 1000);
TWriteDebugThread(FArrayThread).Free;
end;
FreeDebug;
end;

end.
线程单元
unit DebugThread;
interface
uses
Classes, SysUtils;
type
TWriteDebugThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
end;

implementation
uses TestUt;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TWriteDebugThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ TWriteDebugThread }
procedure TWriteDebugThread.Execute;
begin
{ Place thread code here }
while not Terminateddo
begin
WriteDebug('Thread='+IntToStr(Self.ThreadId)+' 测试我的Debug程序');
sleep(100);
end;
end;

end.

这样的程序有问题么？

纠正：函数WriteDebug写错了
应该如下：
procedure TDebug.WriteDebug(ADebugStr: string);
var
DebugStr: string;
filehandle: integer;
fileStream: TFileStream;
begin
try
FLock.Enter;
//检查当前文件是否存在
if not FileExists(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log') then
begin
fileHandle := FileCreate(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log');
FileClose( fileHandle);
end;
fileStream := TFileStream.Create(FDebugFilePath+FDebugFileName+IntToStr(FCurrentFileId)+'.log', fmOpenWrite);
try
fileStream.Seek(0, soFromEnd );
DebugStr := DateTimeToStr(now) + '-->' + ADebugStr+ #13#10;
fileStream.Write(DebugStr[1], Length(DebugStr)) ;
//检查文件是否过大
if fileStream.Size > 100*1024 then
begin
ChangeFileStream;
end;

finally
fileStream.Free;
end;
finally
FLock.Leave;
end;
end;

我又做了个测试，如果我不使用DLL调用，而是直接通过引用单元来调用，那么完全正常，运行很稳定。不知道我封装成DLL后为什么就不行了，在写DLL时哪儿写错了？

rocedure WriteDebug(ADebugStr: string);
begin
MyDebug.WriteDebug(ADebugStr);
end;
改成
procedure WriteDebug(ADebugStr: PChar;Len:Integer);
var
S : String;
begin
SetLength(S, Len);
Move(ADebugStr^, PChar(S)^, Len);
MyDebug.WriteDebug(S);
end;

// 顺便问个问题,
在每个线程里面创建一个TCriticalSection好, 还是全局建立一个TCriticalSection比较快?有什么区别?
TCriticalSection = class(TSynchroObject)
protected
FSection: TRTLCriticalSection;
public
constructor Create;
destructor Destroy;
override;
procedure Acquire;
override;
procedure Release;
override;
procedure Enter;
procedure Leave;
end;

使用内存映射文件试试,不同的线程写不同的位置.

hsgrass，在每个线程里面创建一个TCriticalSection，临界区还有用吗？

DLL调用的话，肯定会出错，因为DLL CALL进去的话会导致不顺序不同步的问题。
你可以用TSimpleEvent来做信号，让他同步，顺序问题，需要用一些缓冲的问题，或者在CALL DLL写文件的时候带入写入数据的offset来却应该写文件的哪个位置。

问题多多,WriteDebug 是 基本的DLL 不应该用string 对象传输，而应该用pchar地址传输。多线程的话，向大家学习。