Piper's Pit BBS/FTP: ibm 0090 - 0099/ibm0090-0099/ibm0099.tar/ibm0099/SAMV11-1.ZIP/API/FINDCALL.PAS

Pascal/Delphi Source File | 1992-11-23 | 5.5 KB | 223 lines

program findcall;
uses dos;

{$I samapi.pas}

var
  SamMuxid : byte;


 { -----------------------------------------------------------------
 . LocateSam
 .
 . Finds the resident SAMAPI code.  This MUST be called before
 . other functions are used!.  It checks for the environment
 . string SAMAPI=number to see if there is an override for the
 . muxid (SAMAPI.EXE does the same thing).
 .
 . returns: true if resident code found and can be used, else false
 . ----------------------------------------------------------------- }


function LocateSam : boolean;
  var
    envstr : string[80];
    v      : integer;
    code   : integer;
    r      : registers;

  begin
    SamMuxid := DEFAULT_SAMMUX;
    envstr := getenv('SAMAPI');
    if length(envstr) <> 0 then
    begin
      val(envstr, v, code);
      if (code = 0) and (v > 0) then
         SamMuxid := v;
    end;
    r.ah := SamMuxid;
    r.al := 0;
    intr($2f, r);
    LocateSam := (r.al = 1);
  end;

 { -----------------------------------------------------------------
 . CallSam
 .
 . Call the resident SAMAPI code.
 .
 . This expects a filled-in (all but header) command buffer
 . and a to-be-filled-in response buffer.  cmd is stuffed into
 . cmdbuf and the resident code is called (via int $2f).
 . ----------------------------------------------------------------- }

procedure CallSam(cmdcode : integer; var cmd, rsp);
  var
    r : registers;
    i : integer;
  begin
    chdr_t (cmd).cmd := cmdcode;
    for i := 0 to 2 do
      chdr_t (cmd).fill[i] := 0;
    r.di := ofs(rsp);
    r.es := seg(rsp);
    r.si := ofs(cmd);
    r.ds := seg(cmd);
    r.al := 1;
    r.ah := SamMuxid;
    intr($2f, r);
  end;

 { -----------------------------------------------------------------
 . FromAsciz
 .
 . This converts a 0 terminated string to pascal style
 . If maximum length exceeded, then string is truncated.
 . ----------------------------------------------------------------- }

procedure FromAsciz(var dst, src; maxlen : integer);
  type
    bary = array [0..256] of byte;
  var
    i : integer;

  begin
    i := 0;
    while (bary(src)[i] <> 0) and (maxlen > 0) do
    begin
      bary(dst)[i+1] := bary(src)[i];
      i := i + 1;
      maxlen := maxlen - 1;
    end;
    bary(dst)[0] := i;   { set the length }
  end;


 { -----------------------------------------------------------------
 . ToAsciz
 .
 . This converts a pascal string to a 0 terminated string
 . If maximum length exceeded, then string is truncated.
 . ----------------------------------------------------------------- }

procedure ToAsciz(var dst, src; maxlen : integer);
  type
    bary = array [0..256] of byte;
  var
    i : integer;

  begin
    i := 0;
    while (bary(src)[0] > i) and (maxlen > 0) do
    begin
      bary(dst)[i] := bary(src)[i+1];
      i := i + 1;
      maxlen := maxlen - 1;
    end;
    bary(dst)[i] := 0;   { set the terminator }
  end;

 { -----------------------------------------------------------------
 . GetSamStrings
 .
 . Extracts the 0-terminated strings from SAM interface datarec_t
 . and puts them in record with pascal type strings
 . ----------------------------------------------------------------- }

procedure GetSamStrings(var p : callstrings_t; var c : datarec_t);
  begin
    FromAsciz(p.Call, c.Call, 6);
    FromAsciz(p.Class, c.Class, 1);
    FromAsciz(p.FirstName, c.FirstName, 11);
    FromAsciz(p.MidInitial, c.MidInitial, 1);
    FromAsciz(p.LastName, c.LastName, 20);
    FromAsciz(p.Address, c.Address, 35);
    FromAsciz(p.City, c.City, 20);
    FromAsciz(p.State, c.State, 2);
    FromAsciz(p.Zip, c.Zip, 5);
    FromAsciz(p.Dob, c.Dob, 2);
  end;

 { -----------------------------------------------------------------
 . display_call_4lines
 .
 . displays call in 4 line format:
 .  1: callsign
 .  2: first [m ]last
 .  3: address
 .  4: city, st zip
 .
 . input is data record strings in pascal format
 .
 . ----------------------------------------------------------------- }

procedure display_call_4lines(rec : callstrings_t);
  begin
    writeln(rec.Call);
    write(rec.FirstName, ' ');
    if (rec.MidInitial[1] <> ' ') then
      write(rec.MidInitial, ' ');
    writeln(rec.LastName);
    writeln(rec.Address);
    writeln(rec.City, ', ', rec.State, ' ', rec.Zip);
  end;


function lookup_call(call : string; var rec : callstrings_t) : integer;
  var
    cmd : cmdfindcall_t;
    rsp : rspdatarec_t;
    len : integer;
    i   : integer;

  begin
    ToAsciz(cmd.call, call, 6);
    cmd.packflags := 0;
    CallSam(SamFindCall, cmd, rsp);
    GetSamStrings(rec, rsp.d);
    lookup_call := rsp.h.err;
  end;

function main : integer;

  var
    drec : callstrings_t;
    err  : integer;
  begin
    main := 0;
    if true <> LocateSam then
    begin
      writeln('*** SAMAPI not installed');
      main := 2
    end
    else if (ParamCount < 1) then
    begin
      writeln('*** No call specified');
      main := 2;
    end
    else
    begin
      err := lookup_call(ParamStr(1), drec);

      if (err <> 0) and (err <> SerrNotFound) then
      begin
        writeln('*** SAMAPI error ', err);
        main := 2;
      end
      else if err <> 0 then
      begin
        writeln('*** Call not found');
        main := 1;
      end
      else
      begin
        display_call_4lines(drec);
      end;
    end;
  end;

  {----------------- main ----------------}
begin
  halt(main);
end.