Metropoli BBS
VIEWER: extra.pas MODE: TEXT (ASCII)
unit extra;

interface

uses crt;

const on  = true;  yes = true;
      off = false;  no = false;

procedure cursor(state : boolean);
procedure fw(x,y : word; s : string; color : byte);

function s2i(s : string) : longint;
function i2s(i : longint) : string;
function i2yn(s : string) : string;
function space(j : byte) : string;
function readstr(x,y,len : byte; sn : string) : string;

function  ini_read(fn,group,handle : string) : string;
procedure ini_change(fn,group,handle,newstr : string);

implementation

procedure cursor;
begin
  case state of
     on : asm
            mov ah,3
            xor bx,bx
            int 10h
            and ch,1fh
            mov ah,1
            int 10h
          end;
    off : asm
            mov ah,3
            xor bx,bx
            int 10h
            or ch,20h
            mov ah,1
            int 10h
          end;
  end;
end;

procedure fw;
var noff : word;
   num,i : integer;
begin
  num := length(s);

  for i := 1 to num do
  begin
    noff := (y-1)*160+((x-1)+(i-1))*2;
    mem[$b800:noff] := ord(s[i]);
    mem[$b800:noff+1] := color;
  end;
end;

function s2i;
var c : integer; i : longint;
begin
  val(s,i,c);
  s2i := i;
end;

function i2s;
var s : string;
begin
  str(i,s);
  i2s := s;
end;

function i2yn;
begin
  case s[1] of
    '0' : i2yn := ' No';
    '1' : i2yn := 'Yes';
  end;
end;

function space;
var s : string;
begin
  fillchar(s,j+1,' ');
  s[0] := chr(j);
  space := s;
end;

function readstr(x,y,len : byte; sn : string) : string;
var key : char;
     ok : boolean;
    org,orgorg,k : string;
begin
  cursor(on);
  textattr := $0F;
  gotoxy(x+len,y); write(#0);
  gotoxy(x,y);
  if sn <> '' then write(space(len-length(sn)),sn);
  k := sn;

  orgorg := sn;
  ok := true;
  while ok do
    if keypressed then
    begin
      key := readkey;
      org := sn;
      case upcase(key) of
'A'..'Z','0'..'9','.',':','\','_','-','^','~','(',')','&','#','!','%' : if length(sn) < len then sn := sn + key;
         #8 : if length(sn) > 0 then sn := copy(sn,1,length(sn)-1);
        #27 : begin
                gotoxy(x,y);
                write(space(len-length(k)),k);
                readstr := orgorg;
                ok := false;
              end;
        #13 : begin
                readstr := sn;
                ok := false;
              end;
      end;
      if org <> sn then
      begin
        gotoxy(x,y);
        write(space(len-length(sn)),sn);
      end;
    end;
  cursor(off);
end;

function  ini_read;
var f : text; s : string; done : boolean;
begin
  assign(f,fn);
  {$i-} reset(f); {$i+} if ioresult <> 0 then exit;

  repeat
    readln(f,s);
  until (copy(s,1,length(group)+2) = '['+group+']') or eof(f);

  done := false;

  if not eof(f) then
  repeat
    readln(f,s);
    if (copy(s,1,length(handle)) = handle) then
    begin
      ini_read := copy(s,length(handle)+2,length(s));
      done := true;
    end;
  until done or eof(f);

  close(f);
end;

procedure ini_change;
var f,n : text; s : string; done : boolean;
begin
  assign(f,fn);
  {$i-} reset(f); {$i+} if ioresult <> 0 then exit;

  assign(n,'temp.---');
  rewrite(n);

  repeat
    readln(f,s);
    writeln(n,s);
  until (copy(s,1,length(group)+2) = '['+group+']') or eof(f);

  done := false;
  if not eof(f) then
  repeat
    readln(f,s);
    if (copy(s,1,length(handle)) = handle) then
    begin
      s := copy(s,1,length(handle)+1)+newstr;
      done := true;
    end;
    writeln(n,s);
  until done or eof(f);

  if not eof(f) then
  repeat
    readln(f,s);
    writeln(n,s);
  until eof(f);

  close(n);
  close(f);
  erase(f);
  rename(n,fn);
end;

begin
end.
[ RETURN TO DIRECTORY ]