有人知道如何將文件（文本）描述符與TStream組件關聯，以便像I/O這樣的writeln（）可以被重定向到流？ （如FPC單元StreamIO）。是否有預定義的函數（我使用XE，但它會很好，如果它也在2009年工作）Writeln to stream
我有很多依賴於writeln（f，）格式化選項的業務代碼，我想更新以登錄網絡。此升級必須以相對安全的方式完成，因爲文件必須保持與字節相同。
（重寫使用其他手段這項業務代碼是不是一個真正的選擇，如果不存在的話，我就必須嘗試自己，或將有一個寫作的臨時文件做並讀）
新增：自定義textrec的任何示例都會受到歡迎，並且/或者哪些字段爲用戶狀態提供了安全空間。
彼得下面寫了這樣的野獸德爾福過，也被稱爲StreamIO，看到http://groups.google.com/group/borland.public.delphi.objectpascal/msg/d682a8b5a5760ac4?pli=1
（鏈接帖子包含的單位）。
你可以看看我們的SynCrtSock Open Source unit。
它實現了很多功能（包括基於http.sys的HTTP/1.1服務器），但它也有一些虛擬文本文件寫入套接字。它用於例如實現HTTP客戶端或服務器或SMTP（發送電子郵件）。
這將是如何創建「虛擬」TTextRec的一個很好的示例，其中包括讀取&寫入內容以及處理錯誤。內部緩衝區大小也從默認值增強 - 在這裏默認情況下有1KB的緩存，而不是128個字節。
例如，下面是如何可以用於發送使用SMTP電子郵件（從單元提取源代碼）：
function SendEmail(const Server: AnsiString; const From, CSVDest, Subject, Text: TSockData;
const Headers: TSockData=''; const User: TSockData=''; const Pass: TSockData='';
const Port: AnsiString='25'): boolean;
var TCP: TCrtSocket;
procedure Expect(const Answer: TSockData);
var Res: TSockData;
begin
repeat
readln(TCP.SockIn^,Res);
until (Length(Res)<4)or(Res[4]<>'-');
if not IdemPChar(pointer(Res),pointer(Answer)) then
raise Exception.Create(string(Res));
end;
procedure Exec(const Command, Answer: TSockData);
begin
writeln(TCP.SockOut^,Command);
Expect(Answer)
end;
var P: PAnsiChar;
rec, ToList: TSockData;
begin
result := false;
P := pointer(CSVDest);
if P=nil then exit;
TCP := Open(Server, Port);
if TCP<>nil then
try
TCP.CreateSockIn; // we use SockIn and SockOut here
TCP.CreateSockOut;
Expect('220');
if (User<>'') and (Pass<>'') then begin
Exec('EHLO '+Server,'25');
Exec('AUTH LOGIN','334');
Exec(Base64Encode(User),'334');
Exec(Base64Encode(Pass),'235');
end else
Exec('HELO '+Server,'25');
writeln(TCP.SockOut^,'MAIL FROM:<',From,'>'); Expect('250');
ToList := 'To: ';
repeat
rec := trim(GetNextItem(P));
if rec='' then continue;
if pos(TSockData('<'),rec)=0 then
rec := '<'+rec+'>';
Exec('RCPT TO:'+rec,'25');
ToList := ToList+rec+', ';
until P=nil;
Exec('DATA','354');
writeln(TCP.SockOut^,'Subject: ',Subject,#13#10,
ToList,#13#10'Content-Type: text/plain; charset=ISO-8859-1'#13#10+
'Content-Transfer-Encoding: 8bit'#13#10,
Headers,#13#10#13#10,Text);
Exec('.','25');
writeln(TCP.SockOut^,'QUIT');
result := true;
finally
TCP.Free;
end;
end;
它將僅產生安西內容，根據定義。它的目標是德爾福5到XE2 - 所以將包括Delphi 2009或XE。
+1還不錯，因爲它顯示其他功能。雖然看起來沒有64位安全。在* nix句柄是32位，並且一個指針不適合它。 – 2012-01-31 19:19:07
嗯，在第二次檢查時，Delphi將它定義爲THandle。一個窗口類型，我不知道他們如何在* nix上定義它。 – 2012-02-01 10:18:28
我發佈了這個回答的另一個問題，它恰好是一個值得考慮的方法，雖然你想寫WriteLn（F，任意數量的參數），但我不能不幸地完全模仿WriteLn(F, ...)，我的WriteLine(aString)方法。
我想使用ReadLn和WriteLn，但在流上。不幸的是，我不能在WriteLn中支持任意參數，但是我可以編寫一個字符串，它與Format（）結合對我來說已經足夠了。即object.WriteLine(Format('stuff %d',[aIntValue]))
我希望能夠讀取任何可能具有CR，CR + LF或僅LF結尾的文件。我只需要Ansi/Ascii支持，因爲它目前使用RawByteString，但是，您可以輕鬆地爲此類添加UTF8支持。
需要一個相當於TextFile（文本行文件）的現代類流類。我稱它爲TTextFile，它是一個包裝Stream的讀寫器類。
它應該工作在64位文件位置的基礎上，對於大於2 GB的文件。
我希望這可以在德爾福7和德爾福XE2，以及之間的一切工作。
我希望它非常非常快。
-
要做到上的文件流的現代WriteLn，你可以這樣做：
procedure TForm1.Button1Click(Sender: TObject);
var
ts:TTextStream;
begin
ts := TTextStream.Create('c:\temp\test.txt', fm_OpenWriteShared);
try
for t := 1 to 1000 do
ts.WriteLine('something');
end;
finally
ts.Free;
end;
end;
這裏，如果你想測試的閱讀，你會寫什麼：
procedure TForm1.Button1Click(Sender: TObject);
var
ts:TTextStream;
s:String;
begin
ts := TTextStream.Create('c:\temp\test.txt', fm_OpenReadShared);
try
while not ts.Eof do begin
s := ts.ReadLine;
doSomethingWith(s);
end;
finally
ts.Free;
end;
end;
該課程在這裏：
unit textStreamUnit;
{$M+}
{$R-}
{
textStreamUnit
This code is based on some of the content of the JvCsvDataSet written by Warren Postma, and others,
licensed under MOZILLA Public License.
}
interface
uses
Windows,
Classes,
SysUtils;
const
cQuote = #34;
cLf = #10;
cCR = #13;
{ File stream mode flags used in TTextStream }
{ Significant 16 bits are reserved for standard file stream mode bits. }
{ Standard system values like fmOpenReadWrite are in SysUtils. }
fm_APPEND_FLAG = $20000;
fm_REWRITE_FLAG = $10000;
{ combined Friendly mode flag values }
fm_Append = fmOpenReadWrite or fm_APPEND_FLAG;
fm_OpenReadShared = fmOpenRead or fmShareDenyWrite;
fm_OpenRewrite = fmOpenReadWrite or fm_REWRITE_FLAG;
fm_Truncate = fmCreate or fm_REWRITE_FLAG;
fm_Rewrite = fmCreate or fm_REWRITE_FLAG;
TextStreamReadChunkSize = 8192; // 8k chunk reads.
resourcestring
RsECannotReadFile = 'Cannot read file %';
type
ETextStreamException = class(Exception);
{$ifndef UNICODE}
RawByteString=AnsiString;
{$endif}
TTextStream = class(TObject)
private
FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma.
FFilename: string;
FStreamBuffer: PAnsiChar;
FStreamIndex: Integer;
FStreamSize: Integer;
FLastReadFlag: Boolean;
procedure _StreamReadBufInit;
public
function ReadLine: RawByteString; { read a string, one per line, wow. Text files. Cool eh?}
procedure Append;
procedure Rewrite;
procedure Write(const s: RawByteString); {write a string. wow, eh? }
procedure WriteLine(const s: RawByteString); {write string followed by Cr+Lf }
procedure WriteChar(c: AnsiChar);
procedure WriteCrLf;
//procedure Write(const s: string);
function Eof: Boolean; {is at end of file? }
{ MODE is typically a fm_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.}
constructor Create(const FileName: string; Mode: DWORD = fm_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual;
destructor Destroy; override;
function Size: Int64; //override; // sanity
{ read-only properties at runtime}
property Filename: string read FFilename;
property Stream: TFileStream read FStream; { Get at the underlying stream object}
end;
implementation
// 2 gigabyte file limit workaround:
function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32;
procedure TTextStream.Append;
begin
Stream.Seek(0, soFromEnd);
end;
constructor TTextStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal);
var
IsAppend: Boolean;
IsRewrite: Boolean;
begin
inherited Create;
FFilename := FileName;
FLastReadFlag := False;
IsAppend := (Mode and fm_APPEND_FLAG) <> 0;
IsRewrite := (Mode and fm_REWRITE_FLAG) <> 0;
FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode), Rights);
//Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream}
if IsAppend then
Self.Append // seek to the end.
else
Stream.Position := 0;
if IsRewrite then
Rewrite;
_StreamReadBufInit;
end;
destructor TTextStream.Destroy;
begin
if Assigned(FStream) then
FStream.Position := 0; // avoid nukage
FreeAndNil(FStream);
FreeMem(FStreamBuffer); // Buffered reads for speed.
inherited Destroy;
end;
function TTextStream.Eof: Boolean;
begin
if not Assigned(FStream) then
Result := False
//Result := True
else
Result := FLastReadFlag and (FStreamIndex >= FStreamSize);
//Result := FStream.Position >= FStream.Size;
end;
{ TTextStream.ReadLine:
This reads a line of text, normally terminated by carriage return and/or linefeed
but it is a bit special, and adapted for CSV usage because CR/LF characters
inside quotes are read as a single line.
This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here.
So there should be as few procedure-calls inside the repeat loop as possible.
}
function TTextStream.ReadLine: RawByteString;
var
Buf: array of AnsiChar;
n: Integer;
QuoteFlag: Boolean;
LStreamBuffer: PAnsiChar;
LStreamSize: Integer;
LStreamIndex: Integer;
procedure FillStreamBuffer;
begin
FStreamSize := Stream.Read(LStreamBuffer[0], TextStreamReadChunkSize);
LStreamSize := FStreamSize;
if LStreamSize = 0 then
begin
if FStream.Position >= FStream.Size then
FLastReadFlag := True
else
raise ETextStreamException.CreateResFmt(@RsECannotReadFile, [FFilename]);
end
else
if LStreamSize < TextStreamReadChunkSize then
FLastReadFlag := True;
FStreamIndex := 0;
LStreamIndex := 0;
end;
begin
{ Ignore linefeeds, read until carriage return, strip carriage return, and return it }
SetLength(Buf, 150);
n := 0;
QuoteFlag := False;
LStreamBuffer := FStreamBuffer;
LStreamSize := FStreamSize;
LStreamIndex := FStreamIndex;
while True do
begin
if n >= Length(Buf) then
SetLength(Buf, n + 100);
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamIndex >= LStreamSize then
Break;
Buf[n] := LStreamBuffer[LStreamIndex];
Inc(LStreamIndex);
case Buf[n] of
cQuote: {34} // quote
QuoteFlag := not QuoteFlag;
cLf: {10} // linefeed
if not QuoteFlag then
Break;
cCR: {13} // carriage return
begin
if not QuoteFlag then
begin
{ If it is a CRLF we must skip the LF. Otherwise the next call to ReadLine
would return an empty line. }
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamBuffer[LStreamIndex] = cLf then
Inc(LStreamIndex);
Break;
end;
end
end;
Inc(n);
end;
FStreamIndex := LStreamIndex;
SetString(Result, PAnsiChar(@Buf[0]), n);
end;
procedure TTextStream.Rewrite;
begin
if Assigned(FStream) then
FStream.Size := 0;// truncate!
end;
function TTextStream.Size: Int64; { Get file size }
begin
if Assigned(FStream) then
GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result}
else
Result := 0;
end;
{ Look at this. A stream that can handle a string parameter. What will they think of next? }
procedure TTextStream.Write(const s: RawByteString);
begin
Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. }
end;
procedure TTextStream.WriteChar(c: AnsiChar);
begin
Stream.Write(c, SizeOf(AnsiChar));
end;
procedure TTextStream.WriteCrLf;
begin
WriteChar(#13);
WriteChar(#10);
end;
procedure TTextStream.WriteLine(const s: RawByteString);
begin
Write(s);
WriteCrLf;
end;
procedure TTextStream._StreamReadBufInit;
begin
if not Assigned(FStreamBuffer) then
begin
//FStreamBuffer := AllocMem(TextStreamReadChunkSize);
GetMem(FStreamBuffer, TextStreamReadChunkSize);
end;
end;
end.
這是如何在業務代碼沒有改變的情況下工作的？哪些被明確排除？ – 2012-01-31 18:45:22
我無法用這種方法提供這一部分。你可以在C/C++中編寫一個真正的var-args函數，但是你不能使用Pascal，所以你使用WriteLn，它有自己的缺點。我發佈這個，因爲其他誰搜索問題名稱可能不會反對改變WriteLn（F，X，Y，Z）爲F.WriteLine（FOrmat（'AAA'，[X，Y，Z]）） – 2012-01-31 19:51:29
我沒有看到C言論的真相。對於這種東西const的數組就足夠了，如果我要重寫它。但它改變了我想要避免的確切位置和浮點格式，因爲多個客戶端都有自己的手工製作（可能是可怕的bug）解析器。或者有些客戶注意到稍微不同的四捨五入算法等。 – 2012-01-31 20:27:25
我剛剛使用了沃倫的TextStreamUnit，它的工作原理（謝謝沃倫），但由於我還需要一個句柄，我修改了源代碼以包含它。示例代碼中使用的函數IsFileInUse（FileName）可以在此處找到：http://delphi.about.com/od/delphitips2009/qt/is-file-in-use.htm。當多個客戶端經常讀取某些網絡文件但很少寫入它時，這種組合幫助我處理所有測試情況，而沒有某些服務器應用程序序列化寫入請求。隨意對我修改的示例代碼進行任何改進。順便說一句，你可能會希望在這個操作過程中顯示小時玻璃光標。
下面是示例代碼：
procedure TForm1.Button1Click(Sender: TObject);
const
MAX_RETRIES_TO_LOCK_FILE = 5;
TIME_BETWEEN_LOCK_RETRIES = 300; // ms
FILENAME = 'c:\temp\test.txt';
var
ts:TTextStream;
counter: byte;
begin
try
for counter := 1 to MAX_RETRIES_TO_LOCK_FILE do
begin
if not IsFileInUse(FILENAME) then
begin
// ts := TTextStream.Create(FILENAME, fmCreate or fmShareDenyWrite);
ts := TTextStream.Create(FILENAME, fmOpenReadWrite or fmShareDenyWrite);
if ts.Handle > 0 then
Break
else
FreeAndNil(ts)
end
else
begin
Sleep(TIME_BETWEEN_LOCK_RETRIES); // little pause then try again
end;
end;
if ts.Handle > 0 then
ts.WriteLine('something')
else
MessageDlg('Failed to create create or access file, mtError, [mbOK], 0);
finally
if Assigned(ts) then
begin
FlushFileBuffers(ts.Handle);
FreeAndNil(ts);
end;
end;
end;
下面是修改單元：
unit TextStreamUnit;
{$M+}
{$R-}
{
TextStreamUnit
This code is based on some of the content of the JvCsvDataSet written by Warren Postma, and others,
licensed under MOZILLA Public License.
}
interface
uses
Windows,
Classes,
SysUtils;
const
cQuote = #34;
cLf = #10;
cCR = #13;
{ File stream mode flags used in TTextStream }
{ Significant 16 bits are reserved for standard file stream mode bits. }
{ Standard system values like fmOpenReadWrite are in SysUtils. }
fm_APPEND_FLAG = $20000;
fm_REWRITE_FLAG = $10000;
{ combined Friendly mode flag values }
fm_Append = fmOpenReadWrite or fm_APPEND_FLAG;
fm_OpenReadShared = fmOpenRead or fmShareDenyWrite;
fm_OpenRewrite = fmOpenReadWrite or fm_REWRITE_FLAG;
fm_Truncate = fmCreate or fm_REWRITE_FLAG;
fm_Rewrite = fmCreate or fm_REWRITE_FLAG;
TextStreamReadChunkSize = 8192; // 8k chunk reads.
resourcestring
RsECannotReadFile = 'Cannot read file %';
type
ETextStreamException = class(Exception);
{$ifndef UNICODE}
RawByteString=AnsiString;
{$endif}
TTextStream = class(TObject)
private
FStream: TFileStream; // Tried TJclFileStream also but it was too slow! Do NOT use JCL streams here. -wpostma.
FFilename: string;
FStreamBuffer: PAnsiChar;
FStreamIndex: Integer;
FStreamSize: Integer;
FLastReadFlag: Boolean;
FHandle: integer;
procedure _StreamReadBufInit;
public
function ReadLine: RawByteString; { read a string, one per line, wow. Text files. Cool eh?}
procedure Append;
procedure Rewrite;
procedure Write(const s: RawByteString); {write a string. wow, eh? }
procedure WriteLine(const s: RawByteString); {write string followed by Cr+Lf }
procedure WriteChar(c: AnsiChar);
procedure WriteCrLf;
//procedure Write(const s: string);
function Eof: Boolean; {is at end of file? }
{ MODE is typically a fm_xxx constant thatimplies a default set of stream mode bits plus some extended bit flags that are specific to this stream type.}
constructor Create(const FileName: string; Mode: DWORD = fm_OpenReadShared; Rights: Cardinal = 0); reintroduce; virtual;
destructor Destroy; override;
function Size: Int64; //override; // sanity
{ read-only properties at runtime}
property Filename: string read FFilename;
property Handle: integer read FHandle;
property Stream: TFileStream read FStream; { Get at the underlying stream object}
end;
implementation
// 2 gigabyte file limit workaround:
function GetFileSizeEx(h: HFILE; FileSize: PULargeInteger): BOOL; stdcall; external Kernel32;
procedure TTextStream.Append;
begin
Stream.Seek(0, soFromEnd);
end;
constructor TTextStream.Create(const FileName: string; Mode: DWORD; Rights: Cardinal);
var
IsAppend: Boolean;
IsRewrite: Boolean;
begin
inherited Create;
FFilename := FileName;
FLastReadFlag := False;
IsAppend := (Mode and fm_APPEND_FLAG) <> 0;
IsRewrite := (Mode and fm_REWRITE_FLAG) <> 0;
FStream := TFileStream.Create(Filename, {16 lower bits only}Word(Mode), Rights);
FHandle := FStream.Handle;
//Stream := FStream; { this makes everything in the base class actually work if we inherited from Easy Stream}
if IsAppend then
Self.Append // seek to the end.
else
Stream.Position := 0;
if IsRewrite then
Rewrite;
_StreamReadBufInit;
end;
destructor TTextStream.Destroy;
begin
if Assigned(FStream) then
FStream.Position := 0; // avoid nukage
FreeAndNil(FStream);
FreeMem(FStreamBuffer); // Buffered reads for speed.
inherited Destroy;
end;
function TTextStream.Eof: Boolean;
begin
if not Assigned(FStream) then
Result := False
//Result := True
else
Result := FLastReadFlag and (FStreamIndex >= FStreamSize);
//Result := FStream.Position >= FStream.Size;
end;
{ TTextStream.ReadLine:
This reads a line of text, normally terminated by carriage return and/or linefeed
but it is a bit special, and adapted for CSV usage because CR/LF characters
inside quotes are read as a single line.
This is a VERY PERFORMANCE CRITICAL function. We loop tightly inside here.
So there should be as few procedure-calls inside the repeat loop as possible.
}
function TTextStream.ReadLine: RawByteString;
var
Buf: array of AnsiChar;
n: Integer;
QuoteFlag: Boolean;
LStreamBuffer: PAnsiChar;
LStreamSize: Integer;
LStreamIndex: Integer;
procedure FillStreamBuffer;
begin
FStreamSize := Stream.Read(LStreamBuffer[0], TextStreamReadChunkSize);
LStreamSize := FStreamSize;
if LStreamSize = 0 then
begin
if FStream.Position >= FStream.Size then
FLastReadFlag := True
else
raise ETextStreamException.CreateResFmt(@RsECannotReadFile, [FFilename]);
end
else
if LStreamSize < TextStreamReadChunkSize then
FLastReadFlag := True;
FStreamIndex := 0;
LStreamIndex := 0;
end;
begin
{ Ignore linefeeds, read until carriage return, strip carriage return, and return it }
SetLength(Buf, 150);
n := 0;
QuoteFlag := False;
LStreamBuffer := FStreamBuffer;
LStreamSize := FStreamSize;
LStreamIndex := FStreamIndex;
while True do
begin
if n >= Length(Buf) then
SetLength(Buf, n + 100);
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamIndex >= LStreamSize then
Break;
Buf[n] := LStreamBuffer[LStreamIndex];
Inc(LStreamIndex);
case Buf[n] of
cQuote: {34} // quote
QuoteFlag := not QuoteFlag;
cLf: {10} // linefeed
if not QuoteFlag then
Break;
cCR: {13} // carriage return
begin
if not QuoteFlag then
begin
{ If it is a CRLF we must skip the LF. Otherwise the next call to ReadLine
would return an empty line. }
if LStreamIndex >= LStreamSize then
FillStreamBuffer;
if LStreamBuffer[LStreamIndex] = cLf then
Inc(LStreamIndex);
Break;
end;
end
end;
Inc(n);
end;
FStreamIndex := LStreamIndex;
SetString(Result, PAnsiChar(@Buf[0]), n);
end;
procedure TTextStream.Rewrite;
begin
if Assigned(FStream) then
FStream.Size := 0;// truncate!
end;
function TTextStream.Size: Int64; { Get file size }
begin
if Assigned(FStream) then
GetFileSizeEx(FStream.Handle, PULargeInteger(@Result)) {int64 Result}
else
Result := 0;
end;
{ Look at this. A stream that can handle a string parameter. What will they think of next? }
procedure TTextStream.Write(const s: RawByteString);
begin
Stream.Write(s[1], Length(s)); {The author of TStreams would like you not to be able to just write Stream.Write(s). Weird. }
end;
procedure TTextStream.WriteChar(c: AnsiChar);
begin
Stream.Write(c, SizeOf(AnsiChar));
end;
procedure TTextStream.WriteCrLf;
begin
WriteChar(#13);
WriteChar(#10);
end;
procedure TTextStream.WriteLine(const s: RawByteString);
begin
Write(s);
WriteCrLf;
end;
procedure TTextStream._StreamReadBufInit;
begin
if not Assigned(FStreamBuffer) then
begin
//FStreamBuffer := AllocMem(TextStreamReadChunkSize);
GetMem(FStreamBuffer, TextStreamReadChunkSize);
end;
end;
end.
1不錯捕獲。我猜FPC單元StreamIO大部分是一樣的......但我不確定它會處理Unicode文本。在使用Writeln（）時，你可能會用Ansi類型的文本填充。如果您確定目標TStream不會失敗，請不要忘記設置{$ I-}以獲得更快的進程。 – 2012-01-31 15:42:16
相同的單元名稱，相同的函數名稱，我們將採取這一點，非常感謝:-) – 2012-01-31 19:18:11
你可以請提供一些例子如何使用這個單位。 – Branko 2012-02-01 09:08:22