home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The C Users' Group Library 1994 August
/
wc-cdrom-cusersgrouplibrary-1994-08.iso
/
listings
/
v_01_04
/
1n04045a
< prev
next >
Wrap
Text File
|
1990-08-08
|
1KB
|
71 lines
const
HT = chr(9);
CR = chr(13);
MINLONGINT = -MAXLONGINT - 1;
SPACES = [' ', HT, CR];
procedure longval
(s : string; var v : longint; var code : integer);
var
c : char;
digit, i : integer;
neg, overflow : boolean;
n : longint;
function next : char;
begin
if i < length(s) then
begin
inc(i);
next := s[i];
end
else
next := chr(0);
end;
begin
i := 0;
c := next;
while c in SPACES do
c := next;
neg := FALSE;
if c = '+' then
c := next
else if c = '-' then
begin
neg := TRUE;
c := next;
end;
if not (c in ['0' .. '9']) then
begin
code := i;
exit;
end;
n := 0;
overflow := FALSE;
while c in ['0' .. '9'] do
begin
digit := ord(c) - ord('0');
if n < (MINLONGINT + digit) div 10 then
overflow := TRUE;
n := n * 10 - digit;
c := next;
end;
if not neg then
begin
n := -n;
if n < 0 then
overflow := TRUE;
end;
v := n;
if c <> chr(0) then
code := i
else if overflow then
code := i + 1
else
code := 0;
end;