{$APPTYPE CONSOLE}
{$TYPEDADDRESS ON}
{$LONGSTRINGS OFF}
{ --------------------------------------------------------------------------- }
{ only one of the defines below should be active. NOTE: these directives }
{ should match, or be consistent with, the directives used to compile the }
{ ntdll unit. }
{$define USE_POINTERS}
//{$define USE_VAR}
{ --------------------------------------------------------------------------- }
program _strtok_s;
{ finds the next token in an input string. returns a pointer to the next }
{ token found in the input string. returns NULL when no more tokens are }
{ found. Each call modifies the input string by substituting a null }
{ character for the first delimiter that occurs after the returned token. }
{ NOTE that unlike the C runtime version, the ntdll version is not able to }
{ report an error which can happen when some of the parameters are null. }
{ documented at : }
{ }
{ https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/strtok-s-strtok-s-l-wcstok-s-wcstok-s-l-mbstok-s-mbstok-s-l?view=msvc-160 }
uses
sysutils
;
{ strtok_s ----------------------- }
{$ifdef USE_POINTERS}
function strtok_s
(
{ _in_out_ } InoutAsciizString : pchar;
{ _in_ } InAsciizDelimiters : pchar;
{ _in_out_ } InoutContext : ppchar
)
: pchar; cdecl; external ntdll; { !! CDECL }
{$endif}
{$ifdef USE_VAR}
function strtok_s
(
{ _in_out_ } InoutAsciizString : pchar;
{ _in_ } InAsciizDelimiters : pchar;
{ _in_out_ } var InoutContext : pchar
)
: pchar; cdecl; external ntdll; { !! CDECL }
{$endif}
{$ifdef USE_OUT} { same as USE_VAR }
function strtok_s
(
{ _in_out_ } InoutAsciizString : pchar;
{ _in_ } InAsciizDelimiters : pchar;
{ _in_out_ } var InoutContext : pchar
)
: pchar; cdecl; external ntdll; { !! CDECL }
{$endif}
{ finds the next token in an input string. returns a pointer to the next }
{ token found in the input string. returns NULL when no more tokens are }
{ found. Each call modifies the input string by substituting a null }
{ character for the first delimiter that occurs after the returned token. }
{ NOTE that unlike the C runtime version, the ntdll version is not able to }
{ report an error which can happen when some of the parameters are null. }
{ documented at : }
{ }
{ https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/strtok-s-strtok-s-l-wcstok-s-wcstok-s-l-mbstok-s-mbstok-s-l?view=msvc-160 }
procedure HexDump(BaseAddress : pointer;
BlockSize : DWORD);
{ displays a memory block in hex }
const
SPACE = $20; { ASCII space character }
HEX_DUMP_WIDTH = 16; { number of hex values per line }
HexDigits : packed array[0..$F] of char = '0123456789ABCDEF';
var
{ variables related to the formatting of hex strings to be displayed }
Buf : packed array[0..80] of char; { one output line }
HexPtr : ^char; { pointer to hex area of line buffer }
CharPtr : ^char; { pointer to character area of line buffer }
p : PBYTE; { used to walk the memory block }
i : DWORD;
begin
i := 0;
while i < BlockSize do
begin
RtlFillMemory(@Buf, sizeof(Buf), SPACE); { space out the buffer }
{ place the offset at the beginning of the line }
StrFmt(Buf, ' %8.8x : ', [ptruint(pchar(BaseAddress) + i)]);
{ calculate the pointer value to the start of the hex area in buf }
HexPtr := pointer(pchar(@Buf) + strlen(Buf));
{ calculate the pointer value to the start of the character area }
CharPtr := pointer(pchar(HexPtr) + (HEX_DUMP_WIDTH * 3) + 1);
repeat
pchar(p) := pchar(BaseAddress) + i; { current byte pointer }
HexPtr^ := HexDigits[p^ shr 4]; { first nibble }
inc(HexPtr);
{ the typecast byte($F) is necessary to avoid a bug in FPC v3.0.4 that }
{ causes it to access a word instead of a byte. }
HexPtr^ := HexDigits[p^ and byte($F)]; { second nibble }
inc(HexPtr);
{ increment HexPtr again to leave a space between bytes }
inc(HexPtr);
{ if the byte is a printable character then just place it in the char }
{ area of the buffer, otherwise put a dot instead }
CharPtr^ := '.'; { non printable character }
if p^ in [32..126] then CharPtr^ := char(p^); { printable }
inc(CharPtr);
{ put an extra space between the first and second half of the hex area }
if i mod HEX_DUMP_WIDTH = (HEX_DUMP_WIDTH div 2) - 1 then inc(HexPtr);
inc(i);
until (i >= BlockSize) or ((i mod HEX_DUMP_WIDTH) = 0);
CharPtr^ := #0; { null terminate the buffer }
writeln(Buf);
end;
end;
const
AsciizText : pchar = 'A tab character'#9'followed by a newline'#13#10' ' +
' followed by these characters and, a comma.';
Delimiters : pchar = ' ,'#9#13#10;
var
{ strtok_s needs a writeable string. for that reason we copy the AsciiText }
{ into the following array which is writeable. }
TextToTokenize : packed array[0..1023] of char;
Token : pchar;
Context : pchar;
begin
writeln;
writeln;
{ move the text to tokenize to a writeable memory block }
strcpy(TextToTokenize, AsciizText);
writeln(' string to break into tokens');
writeln;
writeln(' ', TextToTokenize);
writeln;
writeln;
writeln(' the set of delimiters to break the string is (space, comma, ' +
'tab, CRLF)');
writeln;
writeln(' ', Delimiters); { tabs and CR/LF will _not_ be visible }
writeln;
HexDump(Delimiters, strlen(Delimiters));
writeln;
writeln;
Token := nil; { initialize }
Context := @TextToTokenize[low(TextToTokenize)];
writeln(' the tokens in the string are');
writeln;
writeln;
repeat
{$ifdef USE_VAR}
Token := strtok_s(Context, Delimiters, Context);
{$endif}
{$ifdef USE_POINTERS}
Token := strtok_s(Context, Delimiters, @Context);
{$endif}
if Token = nil then break;
writeln(' ', Token);
until (Context = nil) or (Context^ = #0);
writeln;
writeln;
writeln('press ENTER/RETURN to end this program');
readln;
end.
Recent
