I have a Delphi 7 code that receives sensor values from an DSP TMS32F28069. The value received by Delphi is Hex file data. For example I send data:
F1;01;01;07;00;00;0A;00;00;00;00;F7
from DSP.
I use Comport 411f and actually when I use windows 10 64 bit english version everything is fine. But when I use windows chinese 64 bit, the data that received sometimes fine sometimes change. I have try on several notebook using windows 7 64 bit chinese version, and it has the same problem. The received files on windows 7 64 bit chinese version showing:
F1;01;01;01;00;00;00;F7;00;00;F7;00.or F1;01;07;01;00;0A;00;00;F7;F7;00;00
and always change.This is the code I wrote in Delphi 7:
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
p:integer;
r:array[1..12]of integer;
h:array[1..12]of String;
begin
comport1.Open;
for p:=1 to 12 do
begin
comport1.Read(r[p],1);
h[p]:= IntToHex((r[p]),2);
sMemo3.Text:= h[1]+';'+h[2]+';'+h[3]+';'+h[4]+';'+h[5]+';'+h[6]+';'+h[7]+';'+h[8]+';'+h[9]+';'+h[10]+';'+h[11]+';'+h[12];//Show data Receive on Memo4//
end;
end;
Please give me any suggestion why this happened on windows 7 64 bit chinese version? because when I use windows 7 64 bit english version, it was also work fine.
Thank you
Remove comport1.Open - it is undoubtedly opened if RxChar event occurs
Local integer array is filled with some crap. comport1.Read(r[p],1); fills only one byte. So use byte array
You output full data array after every byte - it is strange method.
When event fires, port buffer contains Count bytes - so read real number of bytes. Better approach - accumulate received info in global array (or ansistring) and treat it when 12 bytes are received.
Buffer: AnsiString;
...
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
sa: AnsiString;
ByteBuf: array[1..12] of Byte;
begin
SetLength(sa, Count);
comport1.Read(sa[1], Count);
Buffer := Buffer + sa;
while Length(Buffer) >= 12 do begin
Move(Buffer[1], ByteBuf, 12);
TreatData(ByteBuf);
Delete(Buffer, 1, 12);
end;
end;
procedure TreatData(bb: array of Byte);
//treat and output here
Related
I have a Delphi Firemonkey EXIF implementation I'm using in a routine to load image files. I'm trying to determine whether or not the image has been rotated, so I can correct the orientation of the image before displaying it. This routine, in part calls assembly code that executes a BSWAP to determine where header information in the image file is located. Here is a part of the code:
type
TMarker = packed record
Marker : Word; //Section marker
Len : Word; //Length Section
Indefin : Array [0..4] of Char; //Indefiner - "Exif" 00, "JFIF" 00 and ets
Pad : Char; //0x00
end;
TIFDHeader = packed record
pad : Byte; //00h
ByteOrder : Word; //II (4D4D) or MM
i42 : Word; //2A00 (magic number from the 'Hitchhikers Guide'
Offset : Cardinal; //0th offset IFD
Count : Word; // number of IFD entries
end;
function SwapLong(Value: Cardinal): Cardinal;
asm bswap eax end;
procedure TExif.ReadFromFile(const FileName: string);
var
j: TMarker;
ifd: TIFDHeader;
off0: Cardinal; //Null Exif Offset
SOI: Word; //2 bytes SOI marker. FF D8 (Start Of Image)
f: File;
begin
if not FileExists(FileName) then exit;
Init;
System.FileMode:=0; //Read Only open
AssignFile(f,FileName);
reset(f,1);
BlockRead(f,SOI,2);
if SOI=$D8FF then begin //Is this Jpeg
BlockRead(f,j,9);
if j.Marker=$E0FF then begin //JFIF Marker Found
Seek(f,20); //Skip JFIF Header
BlockRead(f,j,9);
end;
//Search Exif start marker;
if j.Marker<>$E1FF then begin
i:=0;
repeat
BlockRead(f,SOI,2); //Read bytes.
inc(i);
until (EOF(f) or (i>1000) or (SOI=$E1FF));
//If we find maker
if SOI=$E1FF then begin
Seek(f,FilePos(f)-2); //return Back on 2 bytes
BlockRead(f,j,9); //read Exif header
end;
end;
if j.Marker=$E1FF then begin //If we found Exif Section. j.Indefin='Exif'.
FValid:=True;
off0:=FilePos(f)+1; //0'th offset Exif header
BlockRead(f,ifd,11); //Read IDF Header
FSwap := ifd.ByteOrder=$4D4D; // II or MM - if MM we have to swap
if FSwap then begin
ifd.Offset := SwapLong(ifd.Offset);
ifd.Count := Swap(ifd.Count);
end;
if ifd.Offset <> 8 then begin
Seek(f, FilePos(f)+abs(ifd.Offset)-8);
end;
This works fine when the application is built for 32-bit Windows, but fails at the SwapLong call under 64-bit Windows. I don't know the first thing about Assembly language and so I'm looking for how to handle the same functionality when building the 64-bit version of the program. Just as a note, in both versions the idf.OffSet value passed to the SwapLong function is 134217728 ($08000000). In the 32-bit version the SwapLong returns a value of 8, but the 64-bit version returns a value of 2694969615 given what appears to be the same input.
I need the 64-bit version to work as I am looking to target 64-bit MAC OSX with the same code. Any help would be greatly appreciated.
The issue exists because the inline assembly assumes the first argument as well as the return value to be using register eax, which is true for Delphi in 32-bit mode as per Delphi's calling convention (and although the inline assembly documentation states that there shouldn't be made any assumptions about registers other than ebp and esp, this always held true even inside of inline assembly statements when they were placed at the top of a function).
However, 64-bit mode uses a different calling convention in which the first argument is in rcx and the return value is using rax. So here you are getting random uninitialized garbage as return value that happened to be in that register (with its bytes swapped) because it's never explicitly set.
The best, portable solution would be to implement the byte swap in pure Pascal without inline assembly:
function SwapLong(Value: Cardinal): Cardinal;
begin
Result := Swap(Value shr 16) or (Cardinal(Swap(Value)) shl 16);
end;
This uses the decades-old Swap function which swaps the lower 2 bytes of a value. This isn't of much use on its own anymore but it can be utilized twice (together with some bit shifting and masking) to shorten code for swapping all 4 bytes of a 32-bit value.
Another way which has more source code but can produce less convoluted assembly code as a result would be accessing the individual bytes in the Cardinal using byte pointers:
function SwapLong(Value: Cardinal): Cardinal; inline;
begin
PByte(#Result)^ := PByte(NativeUInt(#Value) + 3)^;
PByte(NativeUInt(#Result) + 1)^ := PByte(NativeUInt(#Value) + 2)^;
PByte(NativeUInt(#Result) + 2)^ := PByte(NativeUInt(#Value) + 1)^;
PByte(NativeUInt(#Result) + 3)^ := PByte(#Value)^;
end;
64-bit assembly passes parameters in different registers than 32-bit. In this case, parameter will be in ECX register, and return value needs to be in EAX.
That requires different code for 32-bit and 64-bit assembly.
function SwapLong(Value: Cardinal): Cardinal;
{$IFDEF ASSEMBLER}
{$IFDEF CPUX86}
asm
bswap eax
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
mov eax, ecx
bswap eax
end;
{$ENDIF CPUX64}
{$ELSE}
begin
// pascal version
end;
{$ENDIF}
Since inline assembly is only available on Windows, other platforms need pure pascal code as shown in CherryDT's answer
I have this code:
procedure MyFunct(const aBin; aBinSize : Cardinal);
var bytes: Tbytes;
begin
bytes := Tbytes(#aBin);
for var I := 0 to aBinSize - 1 do
writeln(bytes[i]);
end;
var Memory: Pointer
...init the memory...
MyFunct(Memory^, sizeOfMemory);
this was working very well for several years with {$R-} (range check off). however today I decide to deactivate {$R-} and now the code below crash with range check error and when yes that normal because I do length(bytes) it's often equal to 0.
So I can reactivate the {$R-} but now I think it's a fundamental mistake because as far as I understand the length of a Tbyte is store at bytes[-32bit] and most important the reference count of the Tbytes is store at bytes[-64bit]. So now I m affraid that the code before was simply writen the reference count in bytes[-64bit] and destroying my memory (maybe not not sure).
so is it a good practice to do
bytes := Tbytes(#aBin);
If not why the compiler authorize it ? How without a Tbytes I can navigate through each byte of my memory (ie how to access myMemory[x])
You can't type-cast an arbitrary pointer to a TBytes like you are, they are completely different things. The code will fail if the memory being pointed at is not a valid dynamic array to begin with. Your code has been faulty for years, and you are just lucky it did anything at all.
The function needs to look more like this instead when using TBytes as you are:
procedure MyFunct(const aBin; aBinSize : Cardinal);
var bytes: TBytes;
begin
SetLength(bytes, aBinSize);
Move(aBin, bytes[0], aBinSize);
for var I := 0 to aBinSize - 1 do
WriteLn(bytes[i]);
end;
Otherwise, a simpler approach (which is likely what you were attempting to do) would be more like this instead:
procedure MyFunct(const aBin; aBinSize : Cardinal);
var bytes: PByte;
begin
bytes := PByte(#aBin);
for var I := 0 to aBinSize - 1 do
WriteLn(bytes[i]);
end;
When I try the code below there seem to be different output in XE2 compared to D2009.
procedure TForm1.Button1Click(Sender: TObject);
var Outfile:textfile;
myByte: Byte;
begin
assignfile(Outfile,'test_chinese.txt');
Rewrite(Outfile);
for myByte in TEncoding.UTF8.GetPreamble do write(Outfile, AnsiChar(myByte));
//This is the UTF-8 BOM
Writeln(Outfile,utf8string('总结'));
Writeln(Outfile,'°C');
Closefile(Outfile);
end;
Compiling with XE2 on a Windows 8 PC gives in WordPad
??
C
txt hex code: EF BB BF 3F 3F 0D 0A B0 43 0D 0A
Compiling with D2009 on a Windows XP PC gives in Wordpad
总结
°C
txt hex code: EF BB BF E6 80 BB E7 BB 93 0D 0A B0 43 0D 0A
My questions is why it differs and how can I save Chinese characters to a text file using the old text file I/O?
Thanks!
In XE2 onwards, AssignFile() has an optional CodePage parameter that sets the codepage of the output file:
function AssignFile(var F: File; FileName: String; [CodePage: Word]): Integer; overload;
Write() and Writeln() both have overloads that support UnicodeString and WideChar inputs.
So, you can create a file that has its codepage set to CP_UTF8, and then Write/ln() will automatically convert Unicode strings to UTF-8 when writing them to the file.
The downside is that you will not be able to write the UTF-8 BOM using AnsiChar values anymore, because the individual bytes will get converted to UTF-8 and thus not be written correctly. You can get around that by writing the BOM as a single Unicode character (which it what it really is - U+FEFF) instead of as individual bytes.
This works in XE2:
procedure TForm1.Button1Click(Sender: TObject);
var
Outfile: TextFile;
begin
AssignFile(Outfile, 'test_chinese.txt', CP_UTF8);
Rewrite(Outfile);
//This is the UTF-8 BOM
Write(Outfile, #$FEFF);
Writeln(Outfile, '总结');
Writeln(Outfile, '°C');
CloseFile(Outfile);
end;
With that said, if you want something that is more compatible and reliable between D2009 and XE2, use TStreamWriter instead:
procedure TForm1.Button1Click(Sender: TObject);
var
Outfile: TStreamWriter;
begin
Outfile := TStreamWriter.Create('test_chinese.txt', False, TEncoding.UTF8);
try
Outfile.WriteLine('总结');
Outfile.WriteLine('°C');
finally
Outfile.Free;
end;
end;
Or do the file I/O manually:
procedure TForm1.Button1Click(Sender: TObject);
var
Outfile: TFileStream;
BOM: TBytes;
procedure WriteBytes(const B: TBytes);
begin
if B <> '' then Outfile.WriteBuffer(B[0], Length(B));
end;
procedure WriteStr(const S: UTF8String);
begin
if S <> '' then Outfile.WriteBuffer(S[1], Length(S));
end;
procedure WriteLine(const S: UTF8String);
begin
WriteStr(S);
WriteStr(sLineBreak);
end;
begin
Outfile := TFileStream.Create('test_chinese.txt', fmCreate);
try
WriteBytes(TEncoding.UTF8.GetPreamble);
WriteLine('总结');
WriteLine('°C');
finally
Outfile.Free;
end;
end;
You really shouldn't use the old text I/O anymore.
Anyway, you can use TEncoding to get the UTF-8 TBytes like this:
procedure TForm1.Button1Click(Sender: TObject);
var Outfile:textfile;
Bytes: TBytes;
myByte: Byte;
begin
assignfile(Outfile,'test_chinese.txt');
Rewrite(Outfile);
for myByte in TEncoding.UTF8.GetPreamble do write(Outfile, AnsiChar(myByte));
//This is the UTF-8 BOM
Bytes := TEncoding.UTF8.GetBytes('总结');
for myByte in Bytes do begin
Write(Outfile, AnsiChar(myByte));
end;
Writeln(Outfile,'°C');
Closefile(Outfile);
end;
I'm not sure if there is an easier way to write TBytes to a Textfile, maybe somebody else has a better idea.
Edit:
For a pure binary file (File instead of TextFile type) use can use BlockWrite.
There are a couple of tell-tale signs that may tell you what whent wrong when dealing with Unicode. In your case you're seeing "?" in the resulting output file: You get question marks when you try to convert some thing from Unicode to a Code Page and the target Code Page can't represent the requested characters.
Looking at the hex dump it's obvious (counting line terminators) that the question marks are the result of saving the two Chinese characters to the file. The two chars got converted to exactly two question marks. This tells you the Writeln() decided to give you helping and converted the text from UTF8 (a unicode representation) to your local code page. The Delphi team probably decided to do this since the old I/O routines are not supposed to be UNICODE compatible; since you're writing an UTF8 string using the old I/O routines, they're helping you by converting this to your Code Page. You might not welcome that helping hand, but it doesn't mean it was wrong to do so: it's undocumented territory.
Since you now know why that's happening you know what to do to stop it. Let WriteLn() know you're sending something that doesn't need converting. You'll discover that's not particularly easy, since Delphi XE2 apparently "helps you out" whatever you. For example, stuff like this doesn't just change the string type, it converts to AnsiString, going through the code-page conversion routine that gets you question marks:
AnsiString(UTF8String('Whatever Unicode'));
Because of this, and if you need one-liner solutions, you could try a conversion routine, something like this:
function FakeConvert(const InStr: UTF8String): AnsiString;
var N: Integer;
begin
N := Length(InStr);
SetLength(Result, N);
Move(InStr[1], Result[1], N);
end;
You'll then be able to do:
Writeln(Outfile,FakeConvert('总结'));
And it'll do what you expect (I did actually try it before posting!)
Of course the only TRUE answer to this question is, since you upgraded all the way to Delphi XE2:
Stop using deprecated I/O routines, move to TStream based
this code in delphi2007 is convert success
for example:
i have a chinese 短刀 , in delphi2007 convert is B5 CC B5 C6 ,but in delphi 2010 convert is 77 ED 52 00
function StringToHex(str: string): string;
var
i:integer;
s:string;
begin
s:='';
for i:=1 to length(str) do begin
s:=s+inttohex(Integer(str[i]),2);
end;
result:=s;
end;
but in delphi2010, it's wrong
who can edit it work in delphi2010 success?
First, in Delphi 2007, String=AnsiString, and in Delphi 2010, String=UnicodeString. That is enough explanation for you to understand, if you know what AnsiString (char is 8 bits) and UnicodeString (char is 16 bits) means.
Even though you are calling "IntToHex(x,2)", each Delphi 2010 character when converted to an integer will be in the range from 0 to 65535, which means that the IntToHex call is returning between 2 and 4 hex digits, which makes it hard for you to read the results without confusion.
A minimal unicode-aware fix is to change to IntToHex(x,4) for unicode versions of delphi, and maybe put a space in there so you can at least see where the codepoints separate Four digits like 0000 is enough hex digits for a single unicode character represented as hex. Two digits is not enough.
Why are the values different though? That's a good question. Let me try to make it clearer; I believe you are seeing a consequence of using Delphi 2007 and its ANSI+MBCS support (which is codepage reliant) versus Delphi 2010 which uses Unicode Strings. You should not be surprised that MBCS values different from unicode codepoints.
Also you should know that it takes two hex digits to show a byte, and four hex digits to show a Unicode character, which is 16 bits in size.
If you really want to see the Hex of the UTF8 string, then in Delphi 2010 you must create a UTF8 string first. If you really want MBCS, then say so. The whole world is Unicode now, I suggest you let MBCS go.
Fixed code for Unicode strings character codepoints (4 hex digits, 16 bit):
A UnicodeString=String aware version (Delphi 2009,2010,XE):
function StringToHex16(str: string): string;
var
i:integer;
s:string;
begin
s:='';
for i:=1 to length(str) do begin
s:=s+inttohex(Integer(str[i]),4);
end;
result:=s;
end;
UTF8 version for Delphi 2009,2010,XE:
function StringToHexUtf8(str: string): string;
var
i:integer;
s:string;
u:RawByteString;
begin
u := Utf8String(str);
s:='';
for i:=1 to length(u) do begin
s:=s+inttohex(Integer(u[i]),2);
end;
result:=s;
end;
And finally, since probably what you want is to reproduce exactly Delphi 2007's behaviour, here is an explicit example using MBCS functions:
function StringToHexMbcs(str: string;cp:Integer): string;
var
sz,i:integer;
s:string;
u:RawByteString;
flags:Integer;
begin
// use cp 936 or 950 for simplified or traditional chinese mbcs.
flags := WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR;
sz := Windows.WideCharToMultiByte( cp, flags, #str[1],-1,nil,0,nil,nil); // get length.
SetLength(u,sz+1);
Windows.WideCharToMultiByte( cp, flags, #str[1],Length(str),#u[1],sz-1, nil,nil);
s:='';
for i:=1 to sz do begin
s:=s+inttohex(Integer(u[i]),2);
end;
result:=s;
end;
For future reference though, Delphi 2007 is not the gold standard of what is "right". You have to make some effort to understand the difference between MBCS and Unicode.
To obtain the same result in D2010 as in D2007, simple change the function parameter from (Unicode)String to AnsiString. Any string value you pass in, regardless of type, with be converted by the RTL into its MBCS equivalent based on the system default codepage - the same AnsiString has always used in past versions and continues using.
Here's a simple program to check memory allocation. Checking before and after values with Task Manager suggests that each dynamic array takes up 20 bytes of memory at size = 1. The element size is 4, which means 16 bytes of overhead for bookkeeping data.
From looking through system.pas, I can find an array length field at -4 bytes, and a reference count at -8 bytes, but I can't seem to find any references to the other 8. Anyone know what they do?
Sample program:
program Project1;
{$APPTYPE CONSOLE}
type
TDynArray = array of integer;
TLotsOfArrays = array[1..1000000] of TDynArray;
PLotsOfArrays = ^TLotsOfArrays;
procedure allocateArrays;
var
arrays: PLotsOfArrays;
i: integer;
begin
new(arrays);
for I := 1 to 1000000 do
setLength(arrays^[i], 1);
end;
begin
readln;
allocateArrays;
readln;
end.
I had a look into System.pas as well and noticed that the GetMem call in _DynArrayCopyRange supports your analyis:
allocated size = count * element size
+ 2 * Sizeof(Longint)
. So maybe the numbers you get from task manager aren't very accurate. You could try Pointer(someDynArray) := nil and check which memory leak size FastMM reports for more reliable numbers.
Edit: I did a little test program:
program DynArrayLeak;
{$APPTYPE CONSOLE}
uses
SysUtils;
procedure Test;
var
arr: array of Integer;
i: Integer;
begin
for i := 1 to 6 do
begin
SetLength(arr, i);
Pointer(arr) := nil;
end;
end;
begin
ReportMemoryLeaksOnShutdown := True;
Test;
end.
This yields
An unexpected memory leak has occurred. The unexpected small block leaks are:
1 - 12 bytes: Unknown x 1
13 - 20 bytes: Unknown x 2
21 - 28 bytes: Unknown x 2
29 - 36 bytes: Unknown x 1
which supports the 8 byte overhead theory.
Memory allocations have granularity to ensure all allocations are aligned. This is just the slop caused by this.
Updated...
I actually went to check the code (which I should've done before) and I came to the same conclusion as Ulrich, it's not storing any type information, just the 2 Longint overhead then NbElements*ElementSize.
And, Task manager is not accurate for this kind of measure.
With the oddity that if you measure the memory used by the dynarray, it increases non linearly with the size of the element: for a Record with 2 or 3 Integers it's the same size (20), with 4 or 5 it's 28... following the granularity of the blocksizes.
Memory measured with:
// Return the total Memory used as reported by the Memory Manager
function MemoryUsed: Cardinal;
var
MemMgrState: TMemoryManagerState;
SmallBlockState: TSmallBlockTypeState;
begin
GetMemoryManagerState(MemMgrState);
Result := MemMgrState.TotalAllocatedMediumBlockSize + MemMgrState.TotalAllocatedLargeBlockSize;
for SmallBlockState in MemMgrState.SmallBlockTypeStates do begin
Result := Result + SmallBlockState.UseableBlockSize * SmallBlockState.AllocatedBlockCount;
end;
end;