home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / ECO_SQSH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  33.7 KB  |  1,094 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2.  
  3. unit eco_sqsh;
  4. interface
  5. uses
  6.   crt, dos,
  7.   eco_lib, eco_lock
  8.   
  9.   ;
  10.  
  11.  
  12.  
  13. type
  14.   _fido_fromtype = string[35];
  15.   _fido_totype   = string[35];
  16.   _fido_subtype  = string[71];
  17.   _fido_datetype = string[19];
  18.  
  19.  
  20.   _fidomsgtype = record
  21.     from         : _fido_fromtype; (* 0 *)
  22.     towhom       : _fido_totype;   (* 35 *)
  23.     subject      : _fido_subtype;  (* 71 *)
  24.     azdate       : _fido_datetype; (* 142 obsolete/unused ascii date information        *)
  25.     timesread    : word;           (* 162 fido<tm>: number of times read                *)
  26.     dest_node    : word;           (* 164 destination node                              *)
  27.     orig_node    : word;           (* 166 origination node number                       *)
  28.     cost         : word;           (* 168 unit cost charged to send the message         *)
  29.     orig_net     : word;           (* 170 origination network number                    *)
  30.     dest_net     : word;           (* 172 destination network number                    *)
  31.  
  32.     date_written : longint;        (* 176 when user wrote the msg              *)
  33.     date_arrived : longint;        (* 180 when msg arrived on-line             *)
  34.     reply        : word;           (* 184 current msg is a reply to this msg number     *)
  35.     attr         : word;           (* 186 attribute (behavior) of the message           *)
  36.     up           : word;           (* 188 Next message in the thread              *)
  37.   end;
  38.  
  39.  
  40.  
  41.  
  42. const
  43.   msgprivate  = $0001; (* for addressee *only*    * 0000 0000 0000 0001 *)
  44.   msgcrash    = $0002; (* high priority           * 0000 0000 0000 0010 *)
  45.   msgread     = $0004; (* was read by addressee   * 0000 0000 0000 0100 *)
  46.   msgsent     = $0008; (* was sent by fidomail      0000 0000 0000 1000 *)
  47.   msgfile     = $0010; (* subj=file(s) to send    * 0000 0000 0001 0000 *)
  48.   msgfwd      = $0020; (* msg from & to elsewhere   0000 0000 0010 0000 *)
  49.   msgorphan   = $0040; (* msg destination unknown   0000 0000 0100 0000 *)
  50.   msgkill     = $0080; (* delete after sending    * 0000 0000 1000 0000 *)
  51.   msglocal    = $0100; (* msg is local, not net     0000 0001 0000 0000 *)
  52.   msghold     = $0200; (* hold msg for pickup     * 0000 0010 0000 0000 *)
  53.   msgcrap     = $0400; (* ---------------------- x  0000 0100 0000 0000 *)
  54.   msgfrq      = $0800; (* subj=file(s) to get     * 0000 1000 0000 0000 *)
  55.   msgrrq      = $1000; (* msg receipt requested  x* 0001 0000 0000 0000 *)
  56.   msgcpt      = $2000; (* msg is a msg receipt   x* 0010 0000 0000 0000 *)
  57.   msgarq      = $4000; (* audit trail requested  x* 0100 0000 0000 0000 *)
  58.   msgurq      = $8000; (* subj=files(s) to upd   x* 1000 0000 0000 0000 *)
  59.                                                  (*------------------------*)
  60.                                                  (* ^^                     *)
  61.                                                  (* ||                     *)
  62.                                                  (* ||* = preserved by     *)
  63.                                                  (* ||    the network      *)
  64.                                                  (* ||? = stripped by the  *)
  65.                                                  (* |     net (ftsc spec)  *)
  66.                                                  (* |     but preserved    *)
  67.                                                  (* |     by seadog<tm>    *)
  68.                                                  (* |x  = not used by opus *)
  69.                                                  (*------------------------*)
  70.  
  71.  
  72. const
  73.   sysmail      = $0001; (* is a mail area                                *)
  74.   p_rep        = $0002; (* opus: net mail private echomail back          *)
  75.   nopublic     = $0004; (* opus: disallow public messages                *)
  76.   noprivate    = $0008; (* opus: disallow private messages               *)
  77.   anon_ok      = $0010; (* opus: enable anonymous messages               *)
  78.   echomail     = $0020; (* opus: set=echomail clear=not echomail         *)
  79.   opus_ualias  = $0040; (* opus170: use user's alias in this area        *)
  80.   highbit      = $0040; (* max:  allow high-bit chars in this area       *)
  81.   passthrough  = $0080; (* opus170: passthough area only                 *)
  82.   inbound      = $0100; (* opus170: inbound only area                    *)
  83.   nrealname    = $0200; (* max:  don't use ^aREALNAME for this area      *)
  84.   userealname  = $0400; (* max:  use usr.name instead of alias           *)
  85.   conf         = $0800; (* max:  conference-type area (no origin/sb's)   *)
  86.   max_ualias   = $1000; (* max:  use usr.alias instead of usr.name       *)
  87.  
  88.  
  89.  
  90. type
  91.   umsgid_type     = longint;
  92.   recpos_type     = longint;
  93.   _address        = record zone,net,node,point : word end;
  94.   msgbuftype      = array[0..0] of char;
  95.   msgbufptrtype   = ^msgbuftype;
  96.  
  97.  
  98. const
  99.   sqhdrid         = $afae4453;  (* squish headers must have this number *)
  100.   linknext        = 0;
  101.   linkprev        = 1;
  102.   nullframe       = 0;
  103.   frame_msg       = 0;          (* it's a live message *)
  104.   frame_free      = 1;          (* the message is dead, avail for new msg *)
  105.   frame_rle       = 2;          (* type of compression, not implemented *)
  106.   frame_lzw       = 3;          (* type of compression, not implemented *)
  107.   sqmsg_from_size = 36;
  108.   sqmsg_to_size   = 36;
  109.   sqmsg_subj_size = 72;
  110.   max_reply       = 10;         (* max number of stored replies to one msg  *)
  111.  
  112. (* this is the first record in the *.sqd file *)
  113.  
  114. type
  115.   _sqbasetype = record
  116.     len     : word;           (* length of this structure!   0   2 *)
  117.     rsvd1   : word;           (* reserved word   2   4 *)
  118.     num_msg,                  (* number of msgs   4   8 *)
  119.     high_msg,                 (* highest msg -  always equal to num_msg   8  12 *)
  120.     skip_msg: longint;        (* # of msgs to keep in beginning of area  12  16 *)
  121.     high_water : umsgid_type; (* high water marker (umsgid)  16  20 *)
  122.     uid        : umsgid_type; (* last usmgid  20  24 *)
  123.     base       : string[79];  (* base name for squishfile  24 104 *)
  124.     begin_frame,              (* offset of first frame in file 104 108 *)
  125.     last_frame,               (* offset to last frame in file 108 112 *)
  126.     first_free,               (* offset of first free frame in file 112 116 *)
  127.     last_free,                (* ofs of the last free frame 116 120 *)
  128.     end_frame  : recpos_type; (* pointer to end of file 120 124 *)
  129.     max_msg    : longint;     (* maximum number of messages 124 128 *)
  130.     keep_days  : word;        (* max age of messages 128 130 *)
  131.     sz_sqhdr   : word;        (* size of fram header 130 132 *)
  132.     rsvd2      : array[1..124] of byte       (* reserved area 132 256 *)
  133.    end;
  134.  
  135.  
  136. (*
  137.  After thge BASE record, follows a frame record for EACH message. The
  138.  begin_frame in the base should point to the first frame header, and
  139.  the next_frame in the frame header should point to the next one, etc.
  140. *)
  141.  
  142.   _sqfhdrtype = record
  143.     id          : longint;        (* sqhdr.id must always equal sqhdrid *)
  144.     next_frame,                   (* pointer to next msg in base *)
  145.     prev_frame  : recpos_type;    (* pointer to prior msg in base *)
  146.     frame_length,                 (* length of this frame (not counting header) *)
  147.     msg_length,                   (* length of msg in frame. may be less than
  148.                                      frame_length if this frame has been recycled. *)
  149.     clen        : longint;        (* length of the control information. *)
  150.     frame_type  : word;           (* Either FRAME_MESSAGE or FRAME_FREE. The API
  151.                                      has been designed to allow things such
  152.                                      as FRAME_LZSS or FRAME_LZH to be hacked on
  153.                                      later, without changing the application. *)
  154.     rsvd        : word;           (* reserved *)
  155.   end;
  156.  
  157.  
  158. (*
  159.  
  160. But right after each frame header, follows the squish message header,
  161. then the control info, then the text.
  162.  
  163. *)
  164.  
  165.   _sqmhdrtype = record
  166.       attr      : longint;
  167.       fromwhom  : string[sqmsg_from_size-1];
  168.       towhom    : string[sqmsg_to_size-1];
  169.       subj      : string[sqmsg_subj_size-1];
  170.       orig,
  171.       dest      : _address;                   (* origination and destination addresses *)
  172.       date_written,                       (* when user wrote the msg (utc) *)
  173.       date_arrived  : longint;            (* when msg arrived on-line (utc) *)
  174.       utc_ofs   : word;                   (* minutes offset from utc of message writer *)
  175.       replyto   : umsgid_type;
  176.       replies   : array[1..max_reply] of umsgid_type;
  177.       azdate    : string[19];             (* ascii date *)
  178.     end;
  179.  
  180.  
  181. (*
  182.   Each SQD file has a SQI FILES.  The message number YOU see (the user)
  183.   in MAX is really the counter starting from 1 of each record in SQI.
  184.   But the TRUE UNIQUE Message ID is in umsgid. The ofs value will
  185.   point to the frame header in SQD.  These files are small and you
  186.   may read them into a array SqiPtrArrayType using the functions
  187.   below.
  188.  
  189. *)
  190.  
  191.   _sqidxtype = record
  192.     ofs    : recpos_type;           (* offset of frame header *)
  193.     umsgid : umsgid_type;           (* unique message identifier *)
  194.     hash   : longint;               (* 'To' name hash value *)
  195.   end;
  196.  
  197.   sqiptrarraytype = array[1..1] of _sqidxtype;
  198.   sqiptrtype      = ^sqiptrarraytype;
  199.  
  200.  
  201. (*
  202.  
  203. Sizes of various structures.  WARNING, alot of the routines use these
  204. variables. You should be more dynamic and reading the true sizes SCOTT
  205. puts in the squish structures (if any).
  206.  
  207. *)
  208.  
  209.  
  210. const
  211.   _sqbsize : word = sizeof(_sqbasetype);
  212.   _sqfsize : word = sizeof(_sqfhdrtype);
  213.   _sqmsize : word = sizeof(_sqmhdrtype);
  214.   _sqisize : word = sizeof(_sqidxtype);
  215.   _sdmsize : word = sizeof(_fidomsgtype);
  216.  
  217.  
  218. (*
  219.  
  220. Function Prototypes in this unit.
  221.  
  222. *)
  223.  
  224.  
  225.  
  226.   function sqsetsqbsize(var fd: file): integer;
  227.   function sqopensqd(name: string; var fd: file; lock : boolean): integer;
  228.   function sqclosesqd(var fd: file): integer;
  229.   function sqreadbhdr(var fd: file; var sb: _sqbasetype): integer;
  230.   function sqwritebhdr(var fd: file; var sb: _sqbasetype): integer;
  231.   function sqreadfhdr(var fd: file; var sf: _sqfhdrtype; fp: longint): integer;
  232.   function sqwritefhdr(var fd: file; var sf: _sqfhdrtype; fp: longint): integer;
  233.   function sqreadmhdr(var fd: file; var sm: _sqmhdrtype; fp: longint): integer;
  234.   function sqwritemhdr(var fd: file; var sm: _sqmhdrtype; fp: longint): integer;
  235.   function sqreadmtxt(var fd: file; var st; fp: longint; ml: longint): integer;
  236.   function sqwritemtxt(var fd: file; var st; fp: longint; ml: longint): integer;
  237.   function sqopensqi(name: string; var fd: file): integer;
  238.   function sqclosesqi(var fd: file): integer;
  239.   function sqreadsqi(var fd: file; var si: _sqidxtype; fp: longint): integer;
  240.   function sqwritesqi(var fd: file; var si: _sqidxtype; fp: longint): integer;
  241.   function sdmread(name: string; var mh: _fidomsgtype; var mb: msgbufptrtype; var mz: longint): integer;
  242.   function squnlinkframe(var fd: file; var sf: _sqfhdrtype): integer;
  243.   function sqlinkframe(var fd: file; var sf: _sqfhdrtype; tp, lp: longint; op: word): integer;
  244.   function sqfreeframe(var fd: file; var sb: _sqbasetype; rp: longint): integer;
  245.   function sqfindframe(var fd: file; var sb: _sqbasetype; var fl, rp: longint): integer;
  246.   function sqnewframe(var fd: file; var sb: _sqbasetype; var sf: _sqfhdrtype; var ml, rp: longint): integer;
  247.   function sqreplaceframe(var fd: file; var sb: _sqbasetype; var sf: _sqfhdrtype; var rp, ml: longint): integer;
  248.   
  249.   function sqazhashname(var s): longint;
  250.   function sqhashname (name : string) : longint;
  251.   procedure squishsqiptr(var sqiptr : sqiptrtype; fn :pathstr; var sqisize : longint);
  252.   function squishmsgntouid(var sqiptr : sqiptrtype; msgn : word ; totalsqi : word) : longint;
  253.   function squishuidtomsgn(var sqiptr : sqiptrtype; uid : longint; totalsqi : word) : word;
  254.   function getsquishbaserec(fn : pathstr; var sqbaserec : _sqbasetype) : integer;
  255.   function setsquishmsgattribute(var fvsqd : file; var fpos : longint; newattr : longint) : integer;
  256.  
  257.  
  258.   { conversion from MSG to Squish }
  259.   function sdmtosqd(
  260.     mname,
  261.     sname: string;
  262.     var mh : _fidomsgtype;
  263.     var newnum : word;
  264.     lockit : boolean
  265.   ): integer;
  266.  
  267.   procedure arrangetxt(var msg: msgbufptrtype; var msiz, csiz: longint);
  268.  
  269.  
  270.  
  271.  
  272.  
  273. implementation
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281. (* open a "*.SQD" file *)
  282.  
  283. const _sqd_file_locked : boolean = false;  (* dont fuss with this variable *)
  284.  
  285. function sqopensqd(name: string; var fd: file; lock : boolean): integer;
  286. var
  287.    r   : integer;
  288.    ax  : integer;
  289.    cnt : integer;
  290. begin
  291.    r  := fopen(fd,__set_ext(name,'SQD'),_readwrite+_denynone);
  292.    ax := r;
  293.    if (r = 0) and lock and (not _sqd_file_locked) then
  294.       begin
  295.         cnt := 1500;
  296.         repeat
  297.          if not filelock(filerec(fd).handle,lockregion,0,1,ax) then
  298.            begin
  299.             case ax of
  300.               33,        (* lock voilation  *)
  301.               32,        (* share voilation *)
  302.               5,         (* access denied   *)
  303.               167        (* hardware share voilation *)
  304.                  : delay(10);
  305.             end;
  306.             dec(cnt);
  307.            end
  308.          else begin
  309.                ax := 0;
  310.                _sqd_file_locked := true;
  311.               end;
  312.         until (cnt=0) or (ax=0);
  313.       end;
  314.    sqopensqd := ax;
  315. end;
  316.  
  317. (* close a "*.SQD" file *)
  318.  
  319. function sqclosesqd(var fd: file): integer;
  320. var
  321.    r: integer;
  322.    ax : integer;
  323.  
  324. begin
  325.    r := 5;
  326.    if _sqd_file_locked then
  327.       if not filelock(filerec(fd).handle,unlockregion,0,1,ax)
  328.          then writeln(#13#10'>>ERR#', ax, ' :FAILED TO UNLOCK ', __mat2str(filerec(fd).name,50))
  329.          else _sqd_file_locked := false;
  330.    r := fclose(fd);
  331.    sqclosesqd := r
  332. end;
  333.  
  334. (* read any data from a "*.SQD" file *)
  335.  
  336. function sqreaddata(var fd: file; var da; fp: longint; sz: word): integer;
  337. var
  338.    r: integer;
  339. begin
  340.    seek(fd,fp);
  341.    r := ioresult;
  342.    if (r = 0) then
  343.    begin
  344.       blockread(fd,da,sz,r);
  345.       r := ioresult
  346.    end;
  347.    sqreaddata := r
  348. end;
  349.  
  350. (* write any data to a "*.SQD" file *)
  351.  
  352. function sqwritedata(var fd: file; var da; fp: longint; sz: word): integer;
  353. var
  354.    r: integer;
  355. begin
  356.    seek(fd,fp);
  357.    r := ioresult;
  358.    if (r = 0) then
  359.    begin
  360.       blockwrite(fd,da,sz,r);
  361.       r := ioresult
  362.    end;
  363.    sqwritedata := r
  364. end;
  365.  
  366. (* Read a "*.SQD" base header. MAKE SURE SQBSIZE IS SET CURRENTLY FOR
  367.    the version max *)
  368.  
  369. function sqreadbhdr(var fd: file; var sb: _sqbasetype): integer;
  370. begin
  371.    sqreadbhdr := sqreaddata(fd,sb,0,_sqbsize)
  372. end;
  373.  
  374. (*
  375.    Read a "*.SQD" base header structure SIZE. Once you call the SqOPENSQB
  376.    you should call this function to make sure the SQBSIZE variable is
  377.    current.
  378. *)
  379.  
  380. function sqsetsqbsize(var fd: file): integer;
  381.  begin
  382.    sqsetsqbsize := sqreaddata(fd,_sqbsize,0,sizeof(word))
  383.  end;
  384.  
  385. (* write a "*.SQD" base header *)
  386.  
  387. function sqwritebhdr(var fd: file; var sb: _sqbasetype): integer;
  388. begin
  389.    sqwritebhdr := sqwritedata(fd,sb,0,_sqbsize)
  390. end;
  391.  
  392. (* read a "*.SQD" frame header *)
  393.  
  394. function sqreadfhdr(var fd: file; var sf: _sqfhdrtype; fp: longint): integer;
  395. begin
  396.    sqreadfhdr := sqreaddata(fd,sf,fp,_sqfsize)
  397. end;
  398.  
  399. (* write a "*.SQD" frame header *)
  400.  
  401. function sqwritefhdr(var fd: file; var sf: _sqfhdrtype; fp: longint): integer;
  402. begin
  403.    sqwritefhdr := sqwritedata(fd,sf,fp,_sqfsize)
  404. end;
  405.  
  406. (* read a "*.SQD" message header *)
  407.  
  408. function sqreadmhdr(var fd: file; var sm: _sqmhdrtype; fp: longint): integer;
  409. begin
  410.    sqreadmhdr := sqreaddata(fd,sm,fp+_sqfsize,_sqmsize)
  411. end;
  412.  
  413. (* write a "*.SQD" message header *)
  414.  
  415. function sqwritemhdr(var fd: file; var sm: _sqmhdrtype; fp: longint): integer;
  416. begin
  417.    sqwritemhdr := sqwritedata(fd,sm,fp+_sqfsize,_sqmsize)
  418. end;
  419.  
  420. (* read a "*.SQD" message text *)
  421.  
  422. function sqreadmtxt(var fd: file; var st; fp: longint; ml: longint): integer;
  423. begin
  424.    sqreadmtxt := sqreaddata(fd,st,fp+_sqfsize+_sqmsize,ml-_sqmsize)
  425. end;
  426.  
  427. (* write a "*.SQD" message text *)
  428.  
  429. function sqwritemtxt(var fd: file; var st; fp: longint; ml: longint): integer;
  430. begin
  431.    sqwritemtxt := sqwritedata(fd,st,fp+_sqfsize+_sqmsize,ml-_sqmsize)
  432. end;
  433.  
  434. (* open a "*.SQI" file *)
  435.  
  436. function sqopensqi(name: string; var fd: file): integer;
  437. begin
  438.    sqopensqi := fopen(fd,__set_ext(name,'SQI'),_readwrite+_denynone);
  439. end;
  440.  
  441. (* close a "*.SQI" file *)
  442.  
  443. function sqclosesqi(var fd: file): integer;
  444. begin
  445.    sqclosesqi := fclose(fd);
  446. end;
  447.  
  448. (* read a "*.SQI" index record *)
  449.  
  450. function sqreadsqi(var fd: file; var si: _sqidxtype; fp: longint): integer;
  451. var
  452.    r: integer;
  453. begin
  454.    seek(fd,fp*_sqisize);
  455.    r := ioresult;
  456.    if (r = 0) then
  457.    begin
  458.       blockread(fd,si,_sqisize,r);
  459.       r := ioresult
  460.    end;
  461.    sqreadsqi := r
  462. end;
  463.  
  464. (* write a "*.SQI" index record *)
  465.  
  466. function sqwritesqi(var fd: file; var si: _sqidxtype; fp: longint): integer;
  467. var
  468.    r: integer;
  469. begin
  470.    seek(fd,fp*_sqisize);
  471.    r := ioresult;
  472.    if (r = 0) then
  473.    begin
  474.       blockwrite(fd,si,_sqisize,r);
  475.       r := ioresult
  476.    end;
  477.    sqwritesqi := r
  478. end;
  479.  
  480. (* open and read a "*.MSG" file *)
  481.  
  482. function sdmread(name: string; var mh: _fidomsgtype; var mb: msgbufptrtype; var mz: longint): integer;
  483. var
  484.    rc: integer;
  485.    br: word;
  486.    fd: file;
  487. begin
  488.    assign(fd,name);
  489.    reset(fd,1);
  490.    rc := ioresult;
  491.    mb := nil;
  492.    if (rc = 0) then
  493.      begin
  494.       blockread(fd,mh,_sdmsize,br);
  495.       mz := filesize(fd) - _sdmsize;
  496.       getmem(mb,mz);
  497.       blockread(fd,mb^,mz,br);
  498.       if (mb^[br] <> #0) then mb^[br] := #0;  (* force a null terminator *)
  499.       close(fd)
  500.      end;
  501.    sdmread := rc
  502. end;
  503.  
  504. (* unlink a frame from the chain *)
  505.  
  506. function squnlinkframe(var fd: file; var sf: _sqfhdrtype): integer;
  507. var
  508.    r: integer;
  509.    sh: _sqfhdrtype;
  510. begin
  511.    r := 0;
  512.    if (sf.prev_frame <> 0) then
  513.    begin
  514.       r := sqreadfhdr(fd,sh,sf.prev_frame);
  515.       if (r = 0) then
  516.       begin
  517.          sh.next_frame := sf.next_frame;
  518.          r := sqwritefhdr(fd,sh,sf.prev_frame)
  519.       end
  520.    end;
  521.    if ((r = 0) and (sf.next_frame <> 0)) then
  522.    begin
  523.       r := sqreadfhdr(fd,sh,sf.next_frame);
  524.       if (r = 0) then
  525.       begin
  526.          sh.prev_frame := sf.prev_frame;
  527.          r := sqwritefhdr(fd,sh,sf.next_frame)
  528.       end
  529.    end;
  530.    squnlinkframe := r
  531. end;
  532.  
  533. function sqlinkframe(var fd: file; var sf: _sqfhdrtype; tp, lp: longint; op: word): integer;
  534. var
  535.    r: integer;
  536.    nxt: longint;
  537.    sh: _sqfhdrtype;
  538. begin
  539.    r := 0;
  540.    if (tp <> nullframe) then
  541.    begin
  542.       r := sqreadfhdr(fd,sh,tp);
  543.       if (r = 0) then
  544.       begin
  545.          if (op = linknext) then
  546.          begin
  547.             sf.prev_frame := tp;
  548.             nxt := sh.next_frame;
  549.             sh.next_frame := lp
  550.          end
  551.          else
  552.          begin
  553.             sf.next_frame := tp;
  554.             nxt := sh.prev_frame;
  555.             sh.prev_frame := lp
  556.          end;
  557.          r := sqwritefhdr(fd,sh,tp);
  558.          tp := nxt
  559.       end;
  560.       if ((r = 0) and (tp <> nullframe)) then
  561.       begin
  562.          r := sqreadfhdr(fd,sh,tp);
  563.          if (r = 0) then
  564.          begin
  565.             if (op = linknext) then
  566.             begin
  567.                sh.prev_frame := lp;
  568.                sf.next_frame := tp
  569.             end
  570.             else
  571.             begin
  572.                sf.prev_frame := tp;
  573.                sh.next_frame := lp
  574.             end;
  575.             r := sqwritefhdr(fd,sh,tp)
  576.          end
  577.       end
  578.    end;
  579.    sqlinkframe := r
  580. end;
  581.  
  582. function sqrelinkframe(var fd: file; var sf: _sqfhdrtype; rp: longint): integer;
  583. var
  584.    r: integer;
  585. begin
  586.    if (sf.next_frame = nullframe) then
  587.       r := sqlinkframe(fd,sf,sf.prev_frame,rp,linknext)
  588.    else
  589.       r := sqlinkframe(fd,sf,sf.next_frame,rp,linkprev);
  590.    sqrelinkframe := r
  591. end;
  592.  
  593. function sqfreeframe(var fd: file; var sb: _sqbasetype; rp: longint): integer;
  594. var
  595.    r: integer;
  596.    sqn,
  597.    sqn1: _sqfhdrtype;
  598. begin
  599.    r := sqreadfhdr(fd,sqn,rp);
  600.    if (r = 0) then
  601.    begin
  602.       r := squnlinkframe(fd,sqn);
  603.       if (r = 0) then
  604.       begin
  605.          if (sb.begin_frame = rp) then
  606.             sb.begin_frame := sqn.next_frame;
  607.          if (sb.last_frame = rp) then
  608.             sb.last_frame := sqn.prev_frame;
  609.          sqn.frame_type := word(frame_free);
  610.          if (sb.first_free = nullframe) then
  611.          begin
  612.             sb.first_free := rp;
  613.             sb.last_free := rp;
  614.             sqn.prev_frame := nullframe;
  615.             sqn.next_frame := nullframe
  616.          end
  617.          else
  618.          begin
  619.             r := sqreadfhdr(fd,sqn1,sb.last_free);
  620.             if (r = 0) then
  621.             begin
  622.                sqn1.next_frame := rp;
  623.                r := sqwritefhdr(fd,sqn1,sb.last_free);
  624.                sqn.prev_frame := sb.last_free;
  625.                sqn.next_frame := nullframe
  626.             end
  627.          end;
  628.          if (r = 0) then
  629.          begin
  630.             sb.last_free := rp;
  631.             r := sqwritefhdr(fd,sqn,rp)
  632.          end
  633.       end
  634.    end;
  635.    sqfreeframe := r
  636. end;
  637.  
  638. function sqfindframe(var fd: file; var sb: _sqbasetype; var fl, rp: longint): integer;
  639. var
  640.    r: integer;
  641.    sqn: _sqfhdrtype;
  642.    break: boolean;
  643. begin
  644.    r := 0;
  645.    break := false;
  646.    rp := sb.first_free;
  647.    while ((rp > nullframe) and (not break)) do
  648.    begin
  649.       r := sqreadfhdr(fd,sqn,rp);
  650.       if ((r = 0) and (fl < sqn.frame_length)) then
  651.          break := true
  652.       else
  653.          rp := sqn.next_frame
  654.    end;
  655.    if (r = 0) then
  656.    begin
  657.       if (rp = nullframe) then
  658.       begin
  659.          fl := 0;
  660.          rp := sb.end_frame
  661.       end
  662.       else
  663.       begin
  664.          r := squnlinkframe(fd,sqn);
  665.          if (r = 0) then
  666.          begin
  667.             if (sqn.prev_frame = nullframe) then
  668.                sb.first_free := sqn.next_frame;
  669.             if (sqn.next_frame = nullframe) then
  670.                sb.last_free := sqn.prev_frame;
  671.             fl := sqn.frame_length
  672.          end
  673.       end
  674.    end;
  675.    sqfindframe := r
  676. end;
  677.  
  678. function sqnewframe(var fd: file; var sb: _sqbasetype; var sf: _sqfhdrtype; var ml, rp: longint): integer;
  679. var
  680.    r: integer;
  681.    sqn: _sqfhdrtype;
  682. begin
  683.    r := sqfindframe(fd,sb,ml,rp);
  684.    if (r = 0) then
  685.    begin
  686.       if (sb.last_frame <> nullframe) then
  687.       begin
  688.          r := sqreadfhdr(fd,sqn,sb.last_frame);
  689.          if (r = 0) then
  690.          begin
  691.             sqn.next_frame := rp;
  692.             r := sqwritefhdr(fd,sqn,sb.last_frame)
  693.          end
  694.       end
  695.       else
  696.          sb.begin_frame := rp;
  697.       if (r = 0) then
  698.       begin
  699.          sf.id := sqhdrid;
  700.          sf.frame_type := word(frame_msg);
  701.          sf.prev_frame := sb.last_frame;
  702.          sb.last_frame := rp;
  703.          sf.next_frame := nullframe
  704.       end
  705.    end;
  706.    sqnewframe := r
  707. end;
  708.  
  709. function sqreplaceframe(var fd: file; var sb: _sqbasetype; var sf: _sqfhdrtype; var rp, ml: longint): integer;
  710. var
  711.    r: integer;
  712. begin
  713.    r := sqreadfhdr(fd,sf,rp);
  714.    if (r = 0) then
  715.    begin
  716.       if (ml > sf.frame_length) then
  717.       begin
  718.          r := sqfreeframe(fd,sb,rp);
  719.          if (r = 0) then
  720.          begin
  721.             sf.frame_length := ml;
  722.             r := sqfindframe(fd,sb,sf.frame_length,rp);
  723.             if (r = 0) then
  724.             begin
  725.                if (sf.prev_frame = nullframe) then
  726.                   sb.begin_frame := rp;
  727.                if (sf.next_frame = nullframe) then
  728.                   sb.last_frame := rp
  729.             end
  730.          end
  731.       end
  732.    end;
  733.    sqreplaceframe := r
  734. end;
  735.  
  736. (* Convert a asciiz username into a hash value for the index. The logic
  737.    used in this code (pointer arithmetic) is ok to use because we are
  738.    dealing with small lengths and will never exceed 64k.
  739. *)
  740.  
  741. function sqazhashname(var s): longint;
  742. var
  743.    p: ^char;
  744.    g,
  745.    hash: longint;
  746. begin
  747.    hash := 0;
  748.    p := @s;
  749.    while (p^ <> #0) do
  750.    begin
  751.       hash := (hash shl 4) + byte(locase(p^));
  752.       g := (hash and $f0000000);
  753.       if (g <> 0) then
  754.       begin
  755.          hash := (hash or (g shr 24));
  756.          hash := (hash or g)
  757.       end;
  758.       inc(longint(p))
  759.    end;
  760.    sqazhashname := (hash and $7fffffff)
  761. end;
  762.  
  763. (* Convert a Pascal username into a hash value for the index.
  764. *)
  765.  
  766. function sqhashname (name : string) : longint;
  767. var p      : integer;
  768.     hash,g : longint;
  769.  begin
  770.     hash := 0;
  771.     for p := 1 to length(name) do
  772.        begin
  773.         hash := (hash shl 4) + ord(locase(name[p]));
  774.         g    := hash and $f0000000;
  775.         if (g <> 0) then
  776.           begin
  777.               hash := hash or (g shr 24);
  778.               hash := hash or g;
  779.           end;
  780.        end;
  781.     sqhashname := hash and $7fffffff;
  782.  end;
  783.  
  784. (*
  785. The following functions are used convert back and forth between between
  786. the msg number and the unique msg id in the sqi files.  You should use
  787. these for lastread pointers, reply links, etc.
  788. *)
  789.  
  790.  
  791. function squishuidtomsgn(var sqiptr : sqiptrtype; uid : longint; totalsqi : word) : word;
  792. var idx     : word;
  793.  begin
  794.    squishuidtomsgn := 0;
  795.    if (sqiptr <> nil) and (totalsqi > 0) and (uid > 0) then
  796.      begin
  797.        idx := 1;
  798.        while (uid > sqiptr^[idx].umsgid) and ((idx) <= totalsqi) do inc(idx);
  799.        if idx > totalsqi then idx := totalsqi;
  800.        squishuidtomsgn := idx;
  801.      end;
  802.  end;
  803.  
  804. function squishmsgntouid(var sqiptr : sqiptrtype; msgn : word ; totalsqi : word) : longint;
  805.  begin
  806.    squishmsgntouid := 0;
  807.    if (sqiptr <> nil) and (totalsqi > 0) then
  808.      begin
  809.        if msgn > totalsqi then msgn := totalsqi;
  810.        if msgn = 0 then msgn := 1;
  811.        squishmsgntouid := sqiptr^[msgn].umsgid;
  812.      end;
  813.  end;
  814.  
  815. (*
  816.  Open SQI file and read in the entire file.  This is your INDEX system
  817.  to the SQD files. Once in memory, you can cycle thru this list by
  818.  msg #, UID # or user name (hash) and get the offset to the Squish header
  819.  record in the SQD file. (Double check the SQHDR_ID value to make sure
  820.  the record is valid).
  821.  
  822.   ie,  Var sqiptr   : sqpptrtype;
  823.            sqisize  : longint;
  824.            actrecs  : word;
  825.  
  826.        SquishSQIPtr(sqiptr,'XPRESS.SQI',sqisize);
  827.        actrecs   := sqisize div _SQISIZE;
  828.  
  829.        .
  830.        .
  831.        .
  832.  
  833.        FreeMem(sqiptr,sqisize);
  834.  
  835.  Don't forget to FREE the the Sqiptr pointer variable using the sqisize
  836.  passed.
  837.  
  838. *)
  839.  
  840. procedure squishsqiptr(var sqiptr : sqiptrtype; fn :pathstr; var sqisize : longint);
  841. var  fv      : stream;
  842.      abytes  : word;
  843.  
  844.    begin
  845.      sqiptr       := nil;
  846.      sqisize      := 0;
  847.      if fopen(fv,fn,_readonly+_denynone) <> 0 then exit;
  848.      sqisize := filesize(fv);
  849.      if sqisize = 0 then
  850.        begin
  851.          fclose(fv);
  852.          exit;
  853.        end;
  854.      getmem(sqiptr,sqisize);
  855.      if sqiptr <> nil then blockread(fv,sqiptr^,sqisize,abytes);
  856.      fclose(fv);
  857.    end;
  858.  
  859. function getsquishbaserec(fn : pathstr; var sqbaserec : _sqbasetype) : integer;
  860. var fv : stream;
  861.     ax : integer;
  862.     ab : word;
  863.  begin
  864.    ax := fopen(fv,fn,_readonly+_denynone);
  865.    getsquishbaserec := ax;
  866.    if ax = 0 then
  867.      begin
  868.        (* sq base *)
  869.        blockread(fv,sqbaserec,_sqbsize,ab);
  870.        fclose(fv);
  871.      end;
  872.  end;
  873.  
  874.  
  875.  
  876.  
  877.   (* Given message frame position, read message header and set the message
  878.      attribute bit.  The newattr is ORed to the previous value. *)
  879.  
  880.   function setsquishmsgattribute(
  881.     var fvsqd : file;
  882.     var fpos : longint;
  883.     newattr : longint
  884.   ) : integer;
  885.  
  886.   var
  887.     xmsg : _sqmhdrtype;
  888.  
  889.   begin
  890.     setsquishmsgattribute := -1;
  891.     if sqreadmhdr(fvsqd,xmsg,fpos) = 0 then begin
  892.       xmsg.attr := xmsg.attr or newattr;
  893.       setsquishmsgattribute := sqwritemhdr(fvsqd,xmsg,fpos);
  894.     end;
  895.   end;
  896.  
  897.  
  898.  
  899.  
  900.   (* Function, given ptr to buffer and size , will arrange the control info
  901.      and message test, and return the new sizes for both sections *)
  902.   
  903.   procedure arrangetxt(var msg: msgbufptrtype; var msiz, csiz: longint);
  904.   var
  905.     mpos, cpos,
  906.     tsize       : word;
  907.  
  908.   begin
  909.     mpos := 0; cpos := 0; tsize := msiz;
  910.     while (msg^[mpos] = #10) do inc(mpos);
  911.     while (msg^[mpos] = #1) do begin
  912.       if (mpos > cpos) then begin
  913.         move(msg^[mpos],msg^[cpos],msiz - mpos);
  914.         dec(msiz,mpos - cpos); cpos := mpos
  915.       end;
  916.       while (not (msg^[cpos] in [#0,#13])) do inc(cpos);
  917.       if (msg^[cpos] = #13) then begin
  918.         msg^[cpos] := #0;
  919.         mpos := cpos + 1;
  920.         while (msg^[mpos] = #10) do inc(mpos)
  921.       end else mpos := cpos
  922.     end;
  923.     if (msg^[msiz] <> #0) then msg^[msiz] := #0;
  924.     csiz := 0;
  925.     if (msg^[0] = #1) then begin
  926.       while (msg^[csiz] <> #0) do inc(csiz);
  927.       inc(csiz)
  928.     end;
  929.     if (csiz = 0) then begin
  930.       move(msg^[csiz],msg^[csiz+1],msiz);
  931.       inc(msiz);
  932.       msg^[0] := #0;
  933.       csiz := 1
  934.     end
  935.   end;
  936.  
  937.  
  938.  
  939.   (* convert "*.MSG" header to squish message header *)
  940.  
  941.  
  942.   procedure sdmtosqmhdr(var mh: _fidomsgtype; var sh: _sqmhdrtype);
  943.   begin
  944.     fillchar(sh,sizeof(_sqmhdrtype),#0);
  945.     move(mh.towhom,   sh.towhom, 36);
  946.     move(mh.from,     sh.fromwhom,36);
  947.     move(mh.subject,  sh.subj,72);
  948.     move(mh.azdate,   sh.azdate,20);
  949.     sh.orig.zone    := 0;
  950.     sh.dest.zone    := 0;
  951.     sh.orig.net     := mh.orig_net;
  952.     sh.dest.net     := mh.dest_net;
  953.     sh.orig.node    := mh.orig_node;
  954.     sh.dest.node    := mh.dest_node;
  955.     sh.attr         := mh.attr;
  956.     sh.date_written := mh.date_written;
  957.     sh.date_arrived := mh.date_arrived;
  958.     sh.replyto      := mh.reply
  959.   end;
  960.  
  961.  
  962.  
  963.  
  964.   function sdmtosqd(
  965.     mname,
  966.     sname: string;
  967.     var mh : _fidomsgtype;
  968.     var newnum : word;
  969.     lockit     : boolean
  970.   ): integer;
  971.  
  972.   var
  973.     mb              : msgbufptrtype;
  974.     fo, fz, mz, cz  :       longint;
  975.     sb              :   _sqbasetype;
  976.     sf              :   _sqfhdrtype;
  977.     sm              :   _sqmhdrtype;
  978.     si              :    _sqidxtype;
  979.     rc              :       integer;
  980.     fi, fd          :          file;
  981.     msize           :       longint;
  982.  
  983.   begin
  984.     rc := sdmread(mname,mh,mb,msize);
  985.     if (rc = 0) then begin
  986.       mz := msize;
  987.       arrangetxt(mb,mz,cz);
  988.       inc(mz,_sqmsize);
  989.       rc := sqopensqd(sname,fd,lockit);
  990.       if (rc = 0) then begin
  991.         rc := sqreadbhdr(fd,sb);
  992.         if (rc = 0) then begin
  993.           fz := mz;
  994.           rc := sqnewframe(fd,sb,sf,fz,fo);
  995.           if (rc = 0) then begin
  996.             sf.frame_length := fz;
  997.             sf.msg_length   := mz;
  998.             sf.clen         := cz;
  999.             if (sf.frame_length = 0) then begin
  1000.               sf.frame_length := sf.msg_length;
  1001.               sb.end_frame := fo + _sqfsize + _sqmsize + sf.frame_length
  1002.             end;
  1003.             rc := sqwritefhdr(fd,sf,fo);
  1004.             if (rc = 0) then begin
  1005.               sdmtosqmhdr(mh,sm);
  1006.               rc := sqwritemhdr(fd,sm,fo);
  1007.               if (rc = 0) then begin
  1008.                 rc := sqwritemtxt(fd,mb^,fo,mz);
  1009.                 if (rc = 0) then begin
  1010.                   si.ofs    := fo;
  1011.                   si.umsgid := sb.uid;
  1012.                   si.hash   := sqazhashname(sm.towhom);
  1013.                   inc(sb.num_msg);
  1014.                   sb.high_msg := sb.num_msg;
  1015.                   inc(sb.uid);
  1016.                   rc := sqwritebhdr(fd,sb);
  1017.                   if (rc = 0) then begin
  1018.                     rc := sqopensqi(sname,fi);
  1019.                     if (rc = 0) then begin
  1020.                       rc := sqwritesqi(fi,si,sb.num_msg-1);
  1021.                       rc := sqclosesqi(fi);
  1022.                       newnum := sb.num_msg;
  1023.                     end
  1024.                   end
  1025.                 end
  1026.               end
  1027.             end
  1028.           end
  1029.         end;
  1030.         rc := sqclosesqd(fd)
  1031.       end
  1032.     end;
  1033.     if mb <> nil then freemem(mb,msize);
  1034.     sdmtosqd := rc
  1035.   end;
  1036.  
  1037.  
  1038.  
  1039.  
  1040.  
  1041. end.
  1042.  
  1043.  
  1044.  The BASE RECORD and the FRAME RECORD are potentially dynamic records.
  1045.  When a squish file SQD is open, you should call SQSetSQBSize to reset
  1046.  the SQBSIZE variable to proper the length, and when do you read in the
  1047.  BASE RECORD, set the SBFSIZE variable to the value defined in the base
  1048.  record. Doing so, will atleast conform to the way MAX today is setup for
  1049.  the future changes in the base structure.
  1050.  
  1051.  There is no critical error trap routines here. It is your programming
  1052.  responsibility to TRAP and CLOSE, and especially UNLOCK any open SQUISH
  1053.  file if a critical error occurs.  There is a local unit variable
  1054.  _SQD_FILE_LOCKED which is used here to determine if a message based is
  1055.  locked when a closing function is called.  It is suggested that you test
  1056.  for this variable's logical state in your critical error trap routine.
  1057.  
  1058.   Description:
  1059.  
  1060.     Squish has four files:
  1061.  
  1062.      *.SQL   - the lastread pointers are stored for the user. The lastus00.dat
  1063.                file has the user's record number. Seek to it and read a word
  1064.                to get lastread value for the user for the message base.
  1065.  
  1066.      *.SQI   - is a index of LIVE MESSAGES in the Squish *.SQD file. It
  1067.                basically stores the 'unique' message id for each message,
  1068.                the offset of the SQUISH messahe header (sqhdr) and the
  1069.                HASH of the TOWHOM user's name.
  1070.  
  1071.      *.SQD   - has all the mail. The basic layout is:
  1072.  
  1073.                 BASE_RECORD
  1074.  
  1075.                 then for each message
  1076.  
  1077.                   SQUISH MESSAGE HEADER
  1078.                   CONTROL INFORMATION   Where all ^A stuff is stored
  1079.                   TEXT MESSAGE          may not always be null terminated
  1080.  
  1081.                The base record will tell you where the first squish msg header
  1082.                is at, and each msg header will point to the next or prev one.
  1083.  
  1084.                In addition, the base record also will point to the first FREE
  1085.                (one that was marked deleted) Squish Message Header and so on.
  1086.  
  1087.                So from the base record, you can get a "Doublely linked list"
  1088.                of both the live messages and free messages.
  1089.  
  1090.       *.SQB  - something to do with dupe checking and I think it's for the
  1091.                squish mail processor. Not discussed or used in the this API.
  1092.  
  1093.  
  1094.