Unit1.pas:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
btnTestBorland: TButton;
edtBorland: TLabeledEdit;
edtSynopse: TLabeledEdit;
edtSize: TLabeledEdit;
edtSource: TLabeledEdit;
btnTestSynopse: TButton;
btnTestNew: TButton;
edtNew: TLabeledEdit;
procedure edtSizeChange(Sender: TObject);
procedure btnTestBorlandClick(Sender: TObject);
procedure btnTestSynopseClick(Sender: TObject);
procedure btnTestNewClick(Sender: TObject);
private
{ Private declarations }
Size: Cardinal;
Buffer: array[0..128] of Char;
procedure PrepareBuffer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SynopseStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm // faster version by AB
or edx,edx
jz @z
push eax
push ebx
xchg eax,edx
mov ebx,ecx
xor ecx,ecx
@1: cmp byte ptr [eax+ecx],0
lea ecx,ecx+1 // copy last #0
je @s
cmp ecx,ebx
jb @1
@s: pop ebx
call Move
pop eax
@z:
end;
function NewStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
or edx,edx // check Source
jz @z // abort if nil
or eax,eax // check Dest
jz @z // abort if nil
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
@z:
end;
function BorlandStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
// original Borland version
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;
procedure TForm1.edtSizeChange(Sender: TObject);
begin
Size := StrToInt(edtSize.Text);
end;
procedure TForm1.PrepareBuffer;
var
i: Integer;
begin
for i := 0 to Size-1 do
Buffer[i] := Char(i);
Buffer[Size] := '!';
end;
procedure TForm1.btnTestBorlandClick(Sender: TObject);
begin
PrepareBuffer;
BorlandStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtBorland.Text := Buffer;
end;
procedure TForm1.btnTestSynopseClick(Sender: TObject);
begin
PrepareBuffer;
SynopseStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtSynopse.Text := Buffer;
end;
procedure TForm1.btnTestNewClick(Sender: TObject);
begin
PrepareBuffer;
NewStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtNew.Text := Buffer;
end;
end.
Unit1.dfm:
object Form1: TForm1
Left = 585
Top = 173
Width = 374
Height = 296
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnTestBorland: TButton
Left = 56
Top = 96
Width = 89
Height = 25
Caption = 'btnTestBorland'
TabOrder = 0
OnClick = btnTestBorlandClick
end
object edtBorland: TLabeledEdit
Left = 160
Top = 96
Width = 121
Height = 21
EditLabel.Width = 51
EditLabel.Height = 13
EditLabel.Caption = 'edtBorland'
TabOrder = 1
end
object edtSynopse: TLabeledEdit
Left = 160
Top = 144
Width = 121
Height = 21
EditLabel.Width = 56
EditLabel.Height = 13
EditLabel.Caption = 'edtSynopse'
TabOrder = 2
end
object edtSize: TLabeledEdit
Left = 216
Top = 40
Width = 65
Height = 21
EditLabel.Width = 20
EditLabel.Height = 13
EditLabel.Caption = 'Size'
TabOrder = 3
OnChange = edtSizeChange
end
object edtSource: TLabeledEdit
Left = 56
Top = 40
Width = 129
Height = 21
EditLabel.Width = 49
EditLabel.Height = 13
EditLabel.Caption = 'edtSource'
TabOrder = 4
Text = 'ABCDEFGHIJKLMNOP'
end
object btnTestSynopse: TButton
Left = 56
Top = 144
Width = 89
Height = 25
Caption = 'btnTestSynopse'
TabOrder = 5
OnClick = btnTestSynopseClick
end
object btnTestNew: TButton
Left = 56
Top = 192
Width = 89
Height = 25
Caption = 'btnTestNew'
TabOrder = 6
OnClick = btnTestNewClick
end
object edtNew: TLabeledEdit
Left = 160
Top = 192
Width = 121
Height = 21
EditLabel.Width = 37
EditLabel.Height = 13
EditLabel.Caption = 'edtNew'
TabOrder = 7
end
end
Searching for null is for safety: you copy up to MaxLen bytes, but you copy only source chars len, with a MaxLen value set to the destination buffer.
Goal is to avoid any potential destination buffer overflow, for security reasons.
That sounds reasonable, but if so why not add similar checks in the Move routine?
Yours sounds like a nice alternative, but does not work as expected: you will append a #0 at MaxLen position.
I'm not sure what you mean; in my tests it behaves exactly the same as the standard Delphi version (including when MaxLen=0).
]]>function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
end;
Yours sounds like a nice alternative, but does not work as expected: you will append a #0 at MaxLen position.
]]>function SynopseStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
or edx,edx // check Source
jz @z // abort if nil
or eax,eax // check Dest
jz @z // abort if nil
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
@z:
end;
(Also, the original Delphi7 version doesn't appear to check for nils).
]]>The Borland version always adds a null terminator to Dest, the Synopse version does not in my tests.
]]>