block read error - delphi

Can anybody please explain me why I am hitting 'I/O error 998' in the below block read?
function ReadBiggerFile: string;
var
biggerfile: file of char;
BufArray: array [1 .. 4096] of char; // we will read 4 KB at a time
nrcit, i: integer;
sir, path: string;
begin
path := ExtractFilePath(application.exename);
assignfile(biggerfile, path + 'asd.txt');
reset(biggerfile);
repeat
blockread(biggerfile, BufArray, SizeOf(BufArray), nrcit);
for i := 1 to nrcit do
begin
sir := sir + BufArray[i];
Form4.Memo1.Lines.Add(sir);
end;
until (nrcit = 0);
closefile(biggerfile);
ReadBiggerFile := sir;
end;

I think you miss-tagged the question and you're using Delphi 2009+, not Delphi 7. I got the error in the title bar trying your exact code on Delphi 2010 (unicode Delphi). When you say:
var biggerfile: file of Char;
You're declaring the biggerfile to be a file of "records", where each record is a Char. On Unicode Delphi that's 2 bytes. You later request to read SizeOf(BufArray) records, not bytes. That is, you request to 4096 x 2 = 8192 records. But your buffer is only 4096 records long, so you get a weird error.
I was able to fix your code by simply replacing Char with AnsiChar, since AnsiChar has a size of 1, hence the SizeOf() equals Length().
The permanent fix should involve moving from the very old Pascal-style file operations to something modern, TStream based. I'm not sure exactly what you're trying to obtain, but if you simply want to get the content of the file in a string, may I suggest something like this:
function ReadBiggerFile: AnsiString;
var
biggerfile: TFileStream;
begin
biggerfile := TFileStream.Create('C:\Users\Cosmin Prund\Downloads\AppWaveInstall201_385.exe', fmOpenRead or fmShareDenyWrite);
try
SetLength(Result, biggerfile.Size);
biggerfile.Read(Result[1], biggerfile.Size);
finally biggerfile.Free;
end;
end;

Hi: I had the same issue and i simply passed it the first element of the buffer which is the starting point for the memory block like so:
AssignFile(BinFile,binFileName);
reset(BinFile,sizeof(Double));
Aux:=length(numberArray);
blockread(BinFile,numberArray[0],Aux, numRead);
closefile(BinFile);

Related

How to fix "No more files" error in Delphi application with Paradox tables on Windows 10 1803?

In old Delphi applications which use the old and deprecated but still used BDE database engine with Paradox database files residing on a Windows 10 computer that's updated to the 1803 "Spring Creators Update" version, but the client computers using any older version of Windows like Windows 10 1709 or Windows 7, opening a Paradox table sometimes fails with a "No more files" error, idapi32.dll error code DBIERR_OSENMFILE. This raises a EDBEngineError exception in DBTables.pas / TTable.GetHandle(), which is called by TTable.CreateHandle, called by TBDEDataSet.OpenCursor().
The error seems to be caused by some file-sharing related changes in the Windows 10 1803 update. Removing the 1803 update from the file-sharing Windows 10 computer, or updating all the client computers to Windows 10 + 1803 seems to make the error go away.
People have speculated that the changes have something to do with the SMB protocol, maybe Windows Defender and/or other security related issues. Here's a Google Plus discussion
https://plus.google.com/106831056534874810288/posts/F4nsoTz2pDi
How could the "No more files" error be worked around by some reasonably easily doable changes in the Delphi application, while allowing the file-sharing client and server computers to keep using heterogeneous Windows versions?
Please try to refrain from answering or commenting self-evident things like "the sky is blue" or "BDE is old and deprecated". Keeping BDE is a decision that cannot be changed, certainly not as a "bug fix".
As an emergency fix, we have resorted to simply re-trying DbiOpenTable, when it returns the DBIERR_OSENMFILE error code. I posted an answer with source code to the idapi32.dll hack. So far it seems that if the first DbiOpenTable says "No more files", the second try succeeds, and the application works without noticing anything.
WARNING: what follows is a hack. A kludge. Band-aid, glue, duct tape and chewing gum. BDE is old. You are completely on your own if you use BDE and/or if you try this hack. I accept no responsibility over its use. If it works for you, good for you. If it ruins your business, bad for you.
Since the Paradox tables still mostly worked and the error seemed to be slightly randomly triggered, and since someone suspected Windows Defender having something to do with it, I thought maybe it just needs some kicking around. If DbiOpenTable() suddenly starts sometimes failing over a certain combination of SMB client/server versions, because "No more files" ... then why not just try the file operation again. I put an "if it returns a DBIERR_OSENMFILE error, then Sleep() and try again" logic around the DbiOpenTable function, and guess what - it seemed to work.
Hacking around the BDE's "features" is familiar to anyone who has to maintain BDE based applications. So I made a patching hook around idapi32.dll's DbiOpenTable function, starting from an old routine written by Reinaldo Yañez originally to fix the "insufficient disk space" error with BDE when the free disk space is at a 4 GB boundary. See https://cc.embarcadero.com/Item/21475
To use this, add Fix1803 in a uses clause, and call PatchBDE somewhere before starting to open Paradox tables. Maybe call UnPatchBDE when you're done, though I don't think that's necessary.
But remember, you're on your own, and this is highly experimental code.
unit Fix1803;
// * KLUDGE WARNING *
// Patch (hack) idapi32.dll DbiOpenTable() to try harder, to work with Windows 10 1803 "Spring Creators Update".
//
// The patching routine is an extension of code originally written by Reinaldo Yañez.
// see https://cc.embarcadero.com/Item/21475
//
// Some original Spanish comments are left in place.
interface
procedure PatchBDE;
procedure UnPatchBDE;
implementation
uses
Windows, Db, DbTables, BDE, SysUtils;
// ------------------------------------------- DbiOpenTable hook
var DbiOpenTable_address_plus_9 : Pointer;
function Actual_DbiOpenTable_CallStub(hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall; assembler;
asm
// these two instructions are implicitly contained in the start of the function
// push ebp
// mov ebp, esp
add esp, $fffffee8
jmp dword ptr [DbiOpenTable_address_plus_9]
end;
function LogHook_DbiOpenTable (hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall;
var
i : Integer;
begin
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
// if we got the "No more files" error, try again... and again.
i := 1;
while (Result = DBIERR_OSENMFILE) and (i < 10) do
begin
Windows.Sleep(i);
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
Inc(i);
end;
end;
// ------------------------------------------- Patching routines
const // The size of the jump instruction written over the start of the original routine is 5 bytes
NUM_BYTES_OVERWRITTEN_BY_THE_PATCH = 5;
type
TRYPatch = record
OrgAddr: Pointer;
OrgBytes: array[0..NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1] of Byte;
end;
procedure TRYPatch_Clear(var ARYPatch : TRYPatch);
begin
FillChar(ARYPatch, SizeOf(TRYPatch), 0);
end;
function RedirectFunction(OldPtr, NewPtr, CallOrigStub : Pointer; var OriginalRoutineAddressPlusN: Pointer; NumBytesInCompleteInstructionsOverwritten : Integer): TRYPatch;
type
PPtr=^pointer;
PPPtr=^PPtr;
TByteArray=array[0..maxint-1] of byte;
PByteArray=^TByteArray;
function SameBytes(Ptr1, Ptr2 : Pointer; NumBytes : Integer) : Boolean;
var
i : Integer;
begin
Result := true;
i := 0;
while (Result) and (i < NumBytes) do
begin
Result := Result and ((PByteArray(Ptr1)^[i] = PByteArray(Ptr2)^[i]));
Inc(i);
end;
end;
var
PatchingAddress : Pointer;
OldProtect,
Protect : DWORD;
p: PByteArray;
i : Integer;
begin
PatchingAddress := OldPtr;
if PWord(PatchingAddress)^ = $25FF then
begin {Es un JMP DWORD PTR [XXXXXXX](=> Esta utilizando Packages)}
p := PatchingAddress;
PatchingAddress := (PPPtr(#p[2])^)^; // PatchingAddress now points to the start of the actual original routine
end;
// Safety check (as if this thing was "safe"). The given replacement routine must start with the same bytes as the replaced routine.
// Otherwise something is wrong, maybe a different version of idapi32.dll or something.
if (CallOrigStub <> nil) and not SameBytes(PatchingAddress, CallOrigStub, NumBytesInCompleteInstructionsOverwritten) then
raise Exception.Create('Will not redirect function, original call stub doesn''t match.');
// Change memory access protection settings, so we can change the contents
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
// Save the old contents of the first N bytes of the routine we're hooking
Result.OrgAddr := PatchingAddress; // Save the address of the code we're patching (which might not be the same as the original OldPtr given as parameter)
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
result.OrgBytes[i] := PByte(Integer(PatchingAddress) + i)^;
// Replace the first bytes of the original function with a relative jump to the new replacement hook function
// First write the instruction opcode, $E9 : JMP rel32
PByte(PatchingAddress)^:= $E9;
// Then write the instruction's operand: the relative address of the new function
PInteger(Integer(PatchingAddress)+1)^ := Integer(NewPtr) - Integer(PatchingAddress) - 5;
// Address to jump to, for the replacement routine's jump instruction
OriginalRoutineAddressPlusN := Pointer(Integer(PatchingAddress) + NumBytesInCompleteInstructionsOverwritten);
// Restore the access protection settings
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
procedure RestorePatch(RestorePatch: TRYPatch);
var
OldProtect,
Protect : DWORD;
OldPtr: Pointer;
i : Integer;
begin
OldPtr := RestorePatch.OrgAddr;
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
PByte(Integer(OldPtr) + i)^ := RestorePatch.OrgBytes[i];
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
var
idapi32_handle: HMODULE;
Patch_DbiOpenTable : TRYPatch;
procedure PatchBDE;
begin
if idapi32_handle <> 0 then Exit; // already_patched
idapi32_handle := LoadLibrary('idapi32');
if idapi32_handle <> 0 then
begin
Patch_DbiOpenTable := RedirectFunction(GetProcAddress(idapi32_handle, 'DbiOpenTable'), #LogHook_DbiOpenTable, #Actual_DbiOpenTable_CallStub, DbiOpenTable_address_plus_9, 9);
end;
end;
procedure UnPatchBDE;
begin
if idapi32_handle <> 0 then
begin
{Leave everything as before, just in case...}
if Patch_DbiOpenTable.OrgAddr <> nil then
RestorePatch(Patch_DbiOpenTable);
FreeLibrary(idapi32_handle);
idapi32_handle := 0;
end;
end;
initialization
idapi32_handle := 0;
TRYPatch_Clear(Patch_DbiOpenTable);
end.
VMWare, Virtual Box, etc to virtualize an Windows 7. If, as you say, W7 work flawlessly that would solve the problem.

TStringlist not loading Google Contacts file

I'm trying to use a Stringlist to load a CSV file generated by Google Contacts. When i open this file in an text editor like Sublime Text, i can see the contents properly, with 75 lines. This is a sample from the Google Contacts file :
Name,Given Name,Additional Name,Family Name,Yomi Name,Given Name Yomi,Additional Name Yomi,Family Name Yomi,Name Prefix,Name Suffix,Initials,Nickname,Short Name,Maiden Name,Birthday,Gender,Location,Billing Information,Directory Server,Mileage,Occupation,Hobby,Sensitivity,Priority,Subject,Notes,Group Membership,Phone 1 - Type,Phone 1 - Value,Phone 2 - Type,Phone 2 - Value,Phone 3 - Type,Phone 3 - Value
H,H,,,,,,,,,,,,, 1-01-01,,,,,,,,,,,,* My Contacts ::: Importado 01/02/16,,,,,,
H - ?,H,-,?,,,,,,,,,,, 1-01-01,,,,,,,,,,,,* My Contacts ::: Importado 01/02/16,Mobile,031-863-64393,,,,
H - ?,H,-,?,,,,,,,,,,,,,,,,,,,,,,,* My Contacts ::: Importado 01/02/16,Mobile,031-986-364393,,,,
BUT when i try to load this same file using Stringlist, this is what i see in the Stringlist.text property :
'ÿþN'#$D#$A
Here is my code :
procedure Tform1.loadfile;
var sl : tstringlist;
begin
sl := tstringlist.create;
sl.loadfromfile('c:\google.csv');
showmessage('lines : '+inttostr(sl.count)+' / text : '+ sl.text);
end;
This is the result i get :
'1 / 'ÿþN'#$D#$A'
What is happening here ?
Thanks
According to the hex dump you provided, the BOM indicates that your file is encoded using UTF-16LE. You a few options in front of you, as I see it:
Switch to Unicode and use the TnT Unicode controls to work with this file.
Read the file as an array of bytes. Convert to ANSI and then continue using ANSI encoded text. Obviously you'll lose information for any characters than cannot be encoded by your ANSI code page. A cheap way to do this would be to read the file as a byte array. Copy the content after the first two bytes, the BOM, into a WideString. Then assign that WideString to an ANSI string.
Port your program to a Unicode version of Delphi (anything later than Delphi 2007) and work natively with Unicode.
I rather suspect that you are not very familiar with text encodings. If you were then I think you would have been able to answer the question yourself. That's just fine but I urge you to take the time to learn about this issue properly. If you rush into coding now, before having a sound grounding, you are sure to make a mess of it. And we've seen so many people make that same mistake. Please don't add to the list of text encoding casualties.
Thanks to the information of David, i could achieve the task by using the function below ; because Delphi 2007 does not have unicode support, it needs third-party function to do it.
procedure loadUnicodeFile( const filename: String; strings: TStringList);
Procedure SwapWideChars( p: PWideChar );
Begin
While p^ <> #0000 Do Begin
// p^ := Swap( p^ ); //<<< D3
p^ := WideChar( Swap( Word(p^)));
Inc( p );
End; { While }
End; { SwapWideChars }
Var
ms: TMemoryStream;
wc: WideChar;
pWc: PWideChar;
Begin
ms:= TMemoryStream.Create;
try
ms.LoadFromFile( filename );
ms.Seek( 0, soFromend );
wc := #0000;
ms.Write( wc, sizeof(wc));
pWC := ms.Memory;
If pWc^ = #$FEFF Then // normal byte order mark
Inc(pWc)
Else If pWc^ = #$FFFE Then Begin // byte order is big-endian
SwapWideChars( pWc );
Inc( pWc );
End { If }
Else; // no byte order mark
strings.Text := WideChartoString( pWc );
finally
ms.free;
end;
End;

TFileStream read huge files piece by piece

Earlier today I opened a question here asking if my method to scan files in computer was correct. As solution, I received a few tips, and the one of the solutions I thought: "this need to be solved urgent!", was saying about memory overflow, once I was reading the files entirely in memory. So I started trying to find a way to read the files piece by piece, and I got something (wrong/bogus), that I need some help to figure out how to do this correctly.
The method is simple like this for now:
procedure ScanFile(FileName: string);
const
MAX_SIZE = 100*1024*1024;
var
i, aux, ReadLimit: integer;
MyFile: TFileStream;
Target: AnsiString;
PlainText: String;
Buff: array of byte;
TotalSize: Int64;
begin
if (POS('.exe', FileName) = 0) and (POS('.dll', FileName) = 0) and
(POS('.sys', FileName) = 0) then //yeah I know it's not the best way...
begin
try
MyFile:= TFileStream.Create(FileName, fmOpenRead);
except on E: EFOpenError do
MyFile:= NIL;
end;
if MyFile <> NIL then
try
TotalSize:= MyFile.Size;
while TotalSize > 0 do begin
ReadLimit:= Min(TotalSize, MAX_SIZE);
SetLength(Buff, ReadLimit);
MyFile.ReadBuffer(Buff[0], ReadLimit);
PlainText:= RemoveNulls(Buff); //this is to transform the array of bytes in string, I posted the code below too...
for i:= 1 to Length(PlainText) do
begin //Begin the search..
end;
dec(TotalSize, ReadLimit);
end;
finally
MyFile.Free;
end;
end;
Code for RemoveNulls is:
function RemoveNulls(const Buff: array of byte): String;
var
i: integer;
begin
for i:= 0 to Length(Buff) do
begin
if Buff[i] <> 0 then
Result:= Result + Chr(Ord(Buff[i]));
end;
end;
Ok, the problems I got with this code so far was:
1- each time the while is repeated, I get more memory consumed, when I was expecting to get only MAX 100MB as described in the MAX_SIZE variable, right?
2- I created a file with 2 occurrences of what should be filtered, and for some unknown reason I got about 10 repeated occurrences, looks like I'm scanning the file repeatedly.
I appreciate your help guys, and if someone have this kind of code already done, post here please, I don't pretend to re-create the wheel...
I'd say that RemoveNulls is your problem. Suppose that you just read 100MB into a string that you passed to RemoveNulls. You would then allocate a string of length 1. The reallocate to length 2. Then to length 3. Then to length 4. And so on, all the way to length 100*1024*1024.
That process will fragment your memory, as well as being appallingly slow. Heap allocation is to be avoided when performance matters. You've no need for it at all. Read a chunk of the file, and search directly in the buffer that you read.
There are various problems with your code that I can see:
Your file extension check is broken, as I described in your previous question.
You are not handling exceptions correctly, as I described in your previous question.
Your for loop in RemoveNulls has buffer overrun. Loop from low() to high().
It's not possible to comment on the search code since that's not present in the question.

Issue in Converting my Project from D7 to XE4

I've now decided to convert my Delphi 7 project to XE4 , But in One of my Code lines i get an issue of witch i tried to Fix it but with no Hope , So i wish someone can help me in Fixing It .
Here's the issue :
In a Shared Unit used between a Server and Client App ( hotel rooms management system ) i have this Record type:
Type
THotelClientDetails = packed record
LSize: Integer;
ClientName: array[0..25] of char;
ClientRoomN: Integer;
RWithInternet: Boolean;
RoomStatus :Integer;
//... etc
end;
PHotelClientDetails = ^THotelClientDetails;
In the Client App i use the follwing Procedure :
procedure TCForm.SendClientDetailsClick(Sender: TObject);
var
pClientDetails: PHotelClientDetails;
iSize: Integer;
begin
iSize:= SizeOf(THotelClientDetails)+Length(ClientNameEd.Text)+1;
GetMem(pClientDetails,iSize);
ZeroMemory(pClientDetails,iSize);
pClientDetails.LSize := iSize;
StrCopy(pClientDetails.ClientName,PChar(ClientNameEd.Text));
pClientDetails.ClientRoomN :=StrToInt(ClientNEd.text);
pClientDetails.RWithInternet:=ClientWInternet.Checked;
pClientDetails.RoomStatus :=ClientRoomStatus.ItemIndex;
StrCopy(Pointer(Cardinal(pClientDetails)+SizeOf(THotelClientDetails)),
PChar(ClientNameEd.Text));
SendClientsBuffer(pClientDetails,iSize);// to the Server for Check
FreeMem(pClientDetails);
end;
And in the Server App i use the Following Procedure :
Procedure TSForm.GetClientDetails(pClientDetails:PHotelClientDetails; Cntx: Pointer);
var
ClientName: string;
begin
ClientName:=PChar(Cardinal(pClientDetails)+SizeOf(THotelClientDetails));
//*** just a test to get the ClientName
ShowMessage(ClientName);
//***
end;
So my problem is when using Delphi 7 i get the full name sent by the Client App :
for example if i want to send the Client " simon " or "matthew" to the Server
i get the correct name in :
ShowMessage(ClientName);//simon or matthew
But when using the same Procedures in XE4 i always get
sim for simon
and
matt for matthew
that means the Server is not receiving the full Client's Name as with Delphi7 project .
Although is added the unit " System.AnsiStrings; " in Both Projects .
So please how can i fix this Issue ?
and So many thanks .
Simon
Delphi 7 uses ANSI strings (single-byte Chars), while versions of Delphi from 2009 and up use Unicode strings (multi-byte Chars).
The most straightforward fix for your code is to change from Char to AnsiChar, string to AnsiString, and PChar to PAnsiChar:
Type
THotelClientDetails = packed record
LSize: Integer;
ClientName: array[0..25] of AnsiChar;
ClientRoomN: Integer;
RWithInternet: Boolean;
RoomStatus :Integer;
//... etc
end;
StrCopy(pClientDetails.ClientName, PAnsiChar(ClientNameEd.Text));
// and
StrCopy(Pointer(Cardinal(pClientDetails) + SizeOf(THotelClientDetails)),
PAnsiChar(ClientNameEd.Text));
Procedure TSForm.GetClientDetails(pClientDetails:PHotelClientDetails; Cntx: Pointer);
var
ClientName: string;
begin
ClientName := PAnsiChar(Cardinal(pClientDetails)+SizeOf(THotelClientDetails));
//*** just a test to get the ClientName
ShowMessage(ClientName);
//***
end;
There are literally dozens (if not hundreds) of questions relating to porting Delphi code from D2007 and earlier to D2009 and later here. You should spend some time browsing the delphi-2009, delphi-xe, and delphi-xe2 tags here.
I post this as an answer because it easier to format than comments to the question.
Some remarks on things you might want do:
With the Unicode support in Delphi 2009 and up, do not assume that Length will get you the actual number of bytes of a string.
In between Delphi 7 an XE4 the concept op methods on records have been introduced (I think in Delphi 2006). Move parts of the logic SendClientDetailsClick into methods of THotelClientDetails
Since THotelClientDetails.ClientName is limited to 26 bytes (25 AnsiChar character bytes plus a null terminating byte), there is no need for
iSize:= SizeOf(THotelClientDetails)+Length(ClientNameEd.Text)+1;
Which means that iSize:= SizeOf(THotelClientDetails).
The only reason you have a pointer pClientDetails: PHotelClientDetails is that you call
SendClientsBuffer(pClientDetails,iSize);// to the Server for Check
which you can replace by
SendClientsBuffer(ClientDetails,iSize);// to the Server for Check
There is no length guard to prevent copying of more than 25 bytes in
StrCopy(pClientDetails.ClientName,PChar(ClientNameEd.Text));
Use StrLCopy there, not StrCopy.
Why are you performing a copy action from ClientNameEd twice?
StrCopy(pClientDetails.ClientName,PChar(ClientNameEd.Text));
//...
StrCopy(Pointer(Cardinal(pClientDetails)+SizeOf(THotelClientDetails)),
PChar(ClientNameEd.Text));
If you insist on pointers, the FreeMem should be in a finally block.
Something like this is more appropriate:
procedure TCForm.SendClientDetailsClick(Sender: TObject);
var
ClientDetails: PHotelClientDetails;
iSize: Integer;
begin
iSize := SizeOf(THotelClientDetails);
ZeroMemory(#ClientDetails, iSize);
ClientDetails.LSize := iSize;
StrLCopy(ClientDetails.ClientName, PAnsiChar(ClientNameEd.Text), SizeOf(ClientDetails.ClientName)-1);
pClientDetails.ClientRoomN := StrToInt(ClientNEd.text);
pClientDetails.RWithInternet := ClientWInternet.Checked;
pClientDetails.RoomStatus := ClientRoomStatus.ItemIndex;
SendClientsBuffer(#ClientDetails,iSize); // to the Server for Check
end;

How can I get this File Writing code to work with Unicode (Delphi)

I had some code before I moved to Unicode and Delphi 2009 that appended some text to a log file a line at a time:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F, C1 : dword;
begin
if LogFileName <> '' then begin
F := CreateFileA(Pchar(LogFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, 0, 0);
if F <> 0 then begin
SetFilePointer(F, 0, nil, FILE_END);
S := S + #13#10;
WriteFile(F, Pchar(S)^, Length(S), C1, nil);
CloseHandle(F);
end;
end;
end;
But CreateFileA and WriteFile are binary file handlers and are not appropriate for Unicode.
I need to get something to do the equivalent under Delphi 2009 and be able to handle Unicode.
The reason why I'm opening and writing and then closing the file for each line is simply so that other programs (such as WordPad) can open the file and read it while the log is being written.
I have been experimenting with TFileStream and TextWriter but there is very little documentation on them and few examples.
Specifically, I'm not sure if they're appropriate for this constant opening and closing of the file. Also I'm not sure if they can make the file available for reading while they have it opened for writing.
Does anyone know of a how I can do this in Delphi 2009 or later?
Conclusion:
Ryan's answer was the simplest and the one that led me to my solution. With his solution, you also have to write the BOM and convert the string to UTF8 (as in my comment to his answer) and then that worked just fine.
But then I went one step further and investigated TStreamWriter. That is the equivalent of the .NET function of the same name. It understands Unicode and provides very clean code.
My final code is:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F: TStreamWriter;
begin
if LogFileName <> '' then begin
F := TStreamWriter.Create(LogFileName, true, TEncoding.UTF8);
try
F.WriteLine(S);
finally
F.Free;
end;
end;
Finally, the other aspect I discovered is if you are appending a lot of lines (e.g. 1000 or more), then the appending to the file takes longer and longer and it becomes quite inefficient.
So I ended up not recreating and freeing the LogFile each time. Instead I keep it open and then it is very fast. The only thing I can't seem to do is allow viewing of the file with notepad while it is being created.
For logging purposes why use Streams at all?
Why not use TextFiles? Here is a very simple example of one of my logging routines.
procedure LogToFile(Data:string);
var
wLogFile: TextFile;
begin
AssignFile(wLogFile, 'C:\MyTextFile.Log');
{$I-}
if FileExists('C:\MyTextFile.Log') then
Append(wLogFile)
else
ReWrite(wLogFile);
WriteLn(wLogfile, S);
CloseFile(wLogFile);
{$I+}
IOResult; //Used to clear any possible remaining I/O errors
end;
I actually have a fairly extensive logging unit that uses critical sections for thread safety, can optionally be used for internal logging via the OutputDebugString command as well as logging specified sections of code through the use of sectional identifiers.
If anyone is interested I'll gladly share the code unit here.
Char and string are Wide since D2009. Thus you should use CreateFile instead of CreateFileA!
If you werite the string you shoudl use Length( s ) * sizeof( Char ) as the byte length and not only Length( s ). because of the widechar issue. If you want to write ansi chars, you should define s as AnsiString or UTF8String and use sizeof( AnsiChar ) as a multiplier.
Why are you using the Windows API function instead of TFileStream defined in classes.pas?
Try this little function I whipped up just for you.
procedure AppendToLog(filename,line:String);
var
fs:TFileStream;
ansiline:AnsiString;
amode:Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename,{mode}amode);
try
if (amode<>fmCreate) then
fs.Seek(fs.Size,0); {go to the end, append}
ansiline := AnsiString(line)+AnsiChar(#13)+AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(ansiline)^,Length(ansiline));
finally
fs.Free;
end;
Also, try this UTF8 version:
procedure AppendToLogUTF8(filename, line: UnicodeString);
var
fs: TFileStream;
preamble:TBytes;
outpututf8: RawByteString;
amode: Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename, { mode } amode, fmShareDenyWrite);
{ sharing mode allows read during our writes }
try
{internal Char (UTF16) codepoint, to UTF8 encoding conversion:}
outpututf8 := Utf8Encode(line); // this converts UnicodeString to WideString, sadly.
if (amode = fmCreate) then
begin
preamble := TEncoding.UTF8.GetPreamble;
fs.WriteBuffer( PAnsiChar(preamble)^, Length(preamble));
end
else
begin
fs.Seek(fs.Size, 0); { go to the end, append }
end;
outpututf8 := outpututf8 + AnsiChar(#13) + AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(outpututf8)^, Length(outpututf8));
finally
fs.Free;
end;
end;
If you try to use text file or Object Pascal typed/untyped files in a multithreaded application you gonna have a bad time.
No kidding - the (Object) Pascal standard file I/O uses global variables to set file mode and sharing. If your application runs in more than one thread (or fiber if anyone still use them) using standard file operations could result in access violations and unpredictable behavior.
Since one of the main purposes of logging is debugging a multithreaded application, consider using other means of file I/O: Streams and Windows API.
(And yes, I know it is not really an answer to the original question, but I do not wish to log in - therefor I do not have the reputation score to comment on Ryan J. Mills's practically wrong answer.)

Resources