{
Hi..
Well, this is the "Repaired" Packets.Pas Unit. The Unit uses the Mark
May's MKSM106.zip unit plus the Duncan Murdoch Streams unit.
I've placed the URL and a Ftp where the readers can obtain the latest version of
those units.

{PACKETS.PAS : Sort of Objects for Reading-Writing Fidonet PKT type
2+
               files and standard QWK and REP files.
 + Donated to public domain by Best Software Mar del Plata
 + You can contact me via e-mail to sebastianf@usa.net or
                                    bsmdp@usa.net
 + You can compile this unit under BP 6.0 or 7.0.
 + Runs perfectly under Protected Mode
}
UNIT PACKETS;
INTERFACE
USES OBJECTS,DOS, {PASCAL UNITS}
{These units are part of Mark May's Msgbase Objects. You can download
the file from www.dnaco.net/~mmay or you can found the Zip file in
ftp.pcmicro.com or elsewhere.
They are used to write the Pkt or Rep file directly from the Msgbase
}
     MKGLOBT,
     MKMSGABS,
     MKSTRING,
{This unit is the Duncan Murdoch's Streams Units. Used for simple and 
fast
buffering in XMS-EMS. You can found the unit in ftp.garbo.uwasa.fi}
     STREAMS;
CONST
{STATUS CONSTANTS}
 ERROK       = 0;
 ERRFINPKT   =-1;
 ERRFINQWK   =ERRFINPKT;
 ERRNOPKT2   =-2;
 ERRNOMEMORY =-3;
 ERRBADQWKMSG=-4;
 ERRNOTOSS   =-5;
 ERRMAXAREAS =-6;
{PREDEFINDED STRINGS}
AREABADMAIL     ='BADMAIL';
AREAKLUDGE      ='AREA:';
MSGIDKLUDGE     =#1'MSGID:';
INTLKLUDGE      =#1'INTL';
FMPTKLUDGE      =#1'FMPT';
TOPTKLUDGE      =#1'TOPT';
REPLYKLUDGE     =#1'REPLY:';
BAUDIOSPKT      =0;
TIPOPKT         =2;
PRODUCTCODE     =$FF;
VERSION         =$0200;
VALORCAPWORD    =1;
VALORCAPWORDCOPY=256;
COSTOMENSAJE    =0;
ANCHOMENSAJE    :BYTE=80;
ENDOFMSG        :CHAR=#0;
ENDOFPACKET     :STRING[2]=#0#0;
{ATRIBUTOS}
ATRPRIVADO           =    1;
ATRCRASH             =    2;
ATRRECIBIDO          =    4;
ATRENVIADO           =    8;
ATRFILEATTACH        =   16;
ATRENTRANSITO        =   32;
ATRORPHAN            =   64;
ATRBORRARENVIADO     =  128;
ATRLOCAL             =  256;
ATRHOLD              =  512;
ATRDIRECTO           = 1024;
ATRFILEREQUEST       = 2048;
ATRPEDIRRECIBIDO     = 4096;
ATRRETORNARRECIBIDO  = 8192;
ATREXAMINARPEDIDO    =16384;
ATRACTUALIZARPEDIDO  =32768;

TYPE
ORIGPKTHDR=RECORD {THIS IS THE ORIGINAL PKT HEADER}
 ONODE,DNODE,
 ANO,MES,DIA,
 HORA,MINUTO,SEGUNDO,
 BAUDIOS,
 TIPOPAQUETE:WORD;
 ONET,DNET:INTEGER;
 CODPH,REVH:BYTE;
 PASSWORD:ARRAY[1..8] OF CHAR;
 OZONE1,DZONE1,AUXNET,CWORD:WORD;
 CODPL,REVL:BYTE;
 CWORDCOPY,OZONE2,DZONE2,OPOINT,DPOINT:WORD;
 SPECDATA:ARRAY[1..4] OF CHAR;
END;
{MODIFIED PKT HEADER. IT'S FOR PACKETS.PAS ONLY.
 Used for easy access of PKT Headers}
MODPKTHDR=RECORD
 ODIR,DDIR:ADDRTYPE;
 CLAVE:STRING[8];
END;
FECHATYPE=RECORD
 DIA,
 MES,
 ANO:WORD;
END;
HORATYPE=RECORD
 HORA,
 MINUTO,
 SEGUNDO:WORD;
END;
{Modified Message Header
 Used for writing Pkt messages headers in a very easy way}
MODMSGHDR=RECORD
 ATRIBUTOS:WORD;
 DIRORIG,DIRDEST:ADDRTYPE;
 DE,PARA:STRING[36];
 FECHA:FECHATYPE;
 HORA:HORATYPE;
 SOBRE:STRING[72];
 AREA:STRING[40];
END;
{Pkt Message Header. Original}
ORIGMSGHDR=RECORD
 MSGID:WORD;
 ONODE,DNODE,ONET,DNET,
 ATR,
 COSTO:WORD;
 FECHA:ARRAY[1..20] OF CHAR;
END;
{Qwk Header}
QWKHEADER=RECORD
 STATUS:CHAR;
 MSGNUM:ARRAY[1..7] OF CHAR;
 FECHA: ARRAY[1..8] OF CHAR;
 HORA:  ARRAY[1..5] OF CHAR;
 PARA:  ARRAY[1..25] OF CHAR;
 DE:    ARRAY[1..25] OF CHAR;
 SOBRE: ARRAY[1..25] OF CHAR;
 PASSWORD:ARRAY[1..12] OF CHAR;
 REFER: ARRAY[1..8] OF CHAR;
 NUMBLOCKS:ARRAY[1..6] OF CHAR;
 ACTIVO:CHAR;
 AREANUM:WORD;
 FILL:ARRAY[1..2] OF CHAR;
 HASTAG:CHAR;
END;
{}
{This Object is for Read the Pkt named PKTFILE.
 The Message is retrieved from the file to the Pased Text Stream. If 
the
 Stream is nil, it's created. The Header Variable is filled with 
apropiate
 values, and the ReadPktMessage retruns one of Status Constants
}
 PPACKETREADPROCESS=^TPACKETREADPROCESS;
 TPACKETREADPROCESS=OBJECT(TOBJECT)
  PKTHEADER:ORIGPKTHDR;
  PKTSTREAM:PBUFSTREAM;
  CONSTRUCTOR INIT(PKTFILE:STRING);
  PROCEDURE GETPKTORIGADDRESS(VAR DIR:ADDRTYPE);
  PROCEDURE GETPKTDESTADDRESS(VAR DIR:ADDRTYPE);
  FUNCTION  READPKTMESSAGE(VAR HEADER:MODMSGHDR;VAR 
TEXT:PSTREAM):INTEGER;
  DESTRUCTOR DONE;VIRTUAL;
  PRIVATE
   FUNCTION GETSTRINGTONULL:STRING;
   FUNCTION GETMSGHEADER(VAR HDR:MODMSGHDR):INTEGER;
 END;
{This Object Write the Pkt file PKTFILE. Fill's the main Header with
HDRDATA and if the PKTFILE already exists the OVERWRITEHDR boolean 
decides
if the object must replace the Header with HDRDATA or must preserve 
the old
header.
The Pkt Message is writed from the Current Message in MSGBASE and 
fill's the
area name with AREA.
}
 PPACKETWRITEPROCESS=^TPACKETWRITEPROCESS;
 TPACKETWRITEPROCESS=OBJECT(TOBJECT)
  PKTSTREAM:PBUFSTREAM;
  CONSTRUCTOR 
INIT(PKTFILE:STRING;HDRDATA:MODPKTHDR;OVERWRITEHDR:BOOLEAN);
  FUNCTION   WRITEPKTMESSAGE(AREA:STRING;MSGBASE:ABSMSGPTR):INTEGER;
  FUNCTION   WRITEPKTFROMBUFFER(HDR:MODMSGHDR;TEXT:PSTREAM):INTEGER;
  DESTRUCTOR DONE;VIRTUAL;
 END;
{This Object read the Qwkfiles located in the path PATHTOQWKFILES
 The READQWKMESSAGE read the current qwk message into TEXT stream, 
and fill
 the Header with Apropiate values.
}
 PQWKREADPROCESS=^TQWKREADPROCESS;
 TQWKREADPROCESS=OBJECT(TOBJECT)
  BBSID,NOMBREBBS,NOMBRESYSOP,NOMBREUSUARIO:STRING;
  AREALIST:PSTRINGCOLLECTION;
  QWKSTREAM:PBUFSTREAM;
  CONSTRUCTOR INIT(PATHTOQWKFILES:STRING);
  FUNCTION READQWKMESSAGE(VAR HEADER:MODMSGHDR;VAR 
TEXT:PSTREAM):INTEGER;
  DESTRUCTOR DONE;VIRTUAL;
 END;
{This Object writes the Messages.dat file, that conforms the Rep 
file.
 The Write procedure writes the current MSGBASE message to the File 
and
 you must supply the Area Number of the message in the AreaNumb 
field}
 PQWKWRITEPROCESS=^TQWKWRITEPROCESS;
 TQWKWRITEPROCESS=OBJECT(TOBJECT)
  QWKSTREAM:PBUFSTREAM;
  CONSTRUCTOR INIT(PATHTOQWKFILES:STRING;BBSID:STRING);
  FUNCTION WRITEQWKMESSAGE(MSGBASE:ABSMSGPTR;AREANUMB:WORD):INTEGER;
  DESTRUCTOR DONE;VIRTUAL;
 END;
{}
PROCEDURE GETORIGADDRESS(PKT:STRING;VAR ADR:ADDRTYPE);{Que direccion 
origen tiene el paquete PKT}
PROCEDURE GETDESTADDRESS(PKT:STRING;VAR ADR:ADDRTYPE);{Que direccion 
destino tiene el paquete PKT}
IMPLEMENTATION
{}
FUNCTION SCANBUFFER(VAR BLOCK; SIZE: WORD; STR: STRING): 
WORD;ASSEMBLER;
ASM
        PUSH    DS
        LES     DI,BLOCK
        LDS     SI,STR
        MOV     CX,SIZE
        JCXZ    @@3
        CLD
        LODSB
        CMP     AL,1
        JB      @@5
        JA      @@1
        LODSB
        REPNE   SCASB
        JNE     @@3
        JMP     @@5
@@1:    XOR     AH,AH
        MOV     BX,AX
        DEC     BX
        MOV     DX,CX
        SUB     DX,AX
        JB      @@3
        LODSB
        INC     DX
        INC     DX
@@2:    DEC     DX
        MOV     CX,DX
        REPNE   SCASB
        JNE     @@3
        MOV     DX,CX
        MOV     CX,BX
        REP     CMPSB
        JE      @@4
        SUB     CX,BX
        ADD     SI,CX
        ADD     DI,CX
        INC     DI
        OR      DX,DX
        JNE     @@2
@@3:    XOR     AX,AX
        JMP     @@6
@@4:    SUB     DI,BX
@@5:    MOV     AX,DI
        SUB     AX,WORD PTR BLOCK
@@6:    DEC     AX
        POP     DS
END; { SCAN }
PROCEDURE INSERTAAD(CAR:CHAR;VAR S:STRING;TAM:WORD);
VAR
LN:WORD;
FILL:STRING;
ST:STRING;
BEGIN
 IF LENGTH(S)>=TAM THEN EXIT;
 FILL[0]:=CHR(TAM-LENGTH(S));
 FILLCHAR(FILL[1],TAM-LENGTH(S),CAR);
 INSERT(FILL,S,1);
END;
FUNCTION MAYUSMINUS(MN:BOOLEAN;DESTINO:STRING):STRING;
 FUNCTION LOSTR(CONST S:STRING):STRING; ASSEMBLER;
  ASM
    PUSH DS
    LDS  SI,S
    LES  DI,@RESULT
    LODSB            { LOAD AND STORE LENGTH OF STRING }
    STOSB
    XOR  CH,CH
    MOV  CL,AL
    JCXZ @EMPTY      { FIX FOR NULL STRING }
  @LOWERLOOP:
    LODSB
    CMP  AL,'A'
    JB   @CONT
    CMP  AL,'Z'
    JA   @CONT
    ADD  AL,' '
  @CONT:
    STOSB
    LOOP @LOWERLOOP
  @EMPTY:
    POP  DS
  END;  { LOSTR }
  FUNCTION UPSTR(CONST S:STRING):STRING; ASSEMBLER;
  ASM
    PUSH DS
    LDS  SI,S
    LES  DI,@RESULT
    LODSB            { LOAD AND STORE LENGTH OF STRING }
    STOSB
    XOR  CH,CH
    MOV  CL,AL
    JCXZ @EMPTY      { FIX FOR NULL LENGTH STRING }
  @UPPERLOOP:
    LODSB
    CMP  AL,'a'
    JB   @CONT
    CMP  AL,'z'
    JA   @CONT
    SUB  AL,' '
  @CONT:
    STOSB
    LOOP @UPPERLOOP
  @EMPTY:
    POP  DS
  END;  { UPSTR }
BEGIN
 IF MN THEN MAYUSMINUS:=UPSTR(DESTINO) ELSE
            MAYUSMINUS:=LOSTR(DESTINO);
END;
PROCEDURE ACTUALIZAR(VAR M:STRING;L:BYTE);
VAR
FILL:STRING;
BEGIN
 IF LENGTH(M)>L THEN M[0]:=CHAR(L) ELSE
 IF LENGTH(M)<L THEN BEGIN
  FILL[0]:=CHR(L-LENGTH(M));
  FILLCHAR(FILL[1],L-LENGTH(M),' ');
  M:=M+FILL;
 END;
END;
FUNCTION SUBCAD(SOURCE:STRING;PT1,PT2:STRING):STRING;
VAR
STIN:STRING;
P1,P2:BYTE;
M:WORD;
ST1:STRING;
 BEGIN
  STIN:=STRING(SOURCE);
  P1:=POS(PT1,STIN);
  P2:=POS(PT2,STIN);
  IF (P1=0) OR (P2=0) OR (P1>=P2) THEN BEGIN
   SUBCAD:='';
   EXIT;
  END;
  ST1:='';
  FOR M:=P1+1 TO P2-1 DO
  ST1:=ST1+STIN[M];
  SUBCAD:=ST1;
END;
FUNCTION RECORTAFINAL(IND:STRING):STRING;
VAR
P1:INTEGER;
RES:STRING;
BEGIN
 RES:=IND;
 IF RES<>'' THEN BEGIN
  FOR P1:=LENGTH(RES) DOWNTO 1 DO
  IF RES[P1]<>#32 THEN BREAK;
  IF P1>1 THEN SYSTEM.DELETE(RES,P1+1,LENGTH(RES));
 END;
 RECORTAFINAL:=RES;
END;
FUNCTION FULLPATH(INP:STRING):STRING;
VAR
RES:STRING;
BEGIN
 RES:=FEXPAND(INP);
 IF RES[LENGTH(RES)]<>'\' THEN RES:=RES+'\';
 FULLPATH:=RES;
END;
FUNCTION EXISTE(NOMBRE:STRING):BOOLEAN;
VAR
SR:SEARCHREC;
BEGIN
 FINDFIRST(NOMBRE,DOS.ARCHIVE,SR);
 EXISTE:=DOSERROR=0;
END;
{}
FUNCTION FILTER0A(INS:STRING):STRING;
 VAR
 CONT:WORD;
 RES:STRING;
 BEGIN
  RES:='';
  FILTER0A:='';
  IF LENGTH(INS)=0 THEN EXIT;
  FOR CONT:=1 TO LENGTH(INS) DO
   IF INS[CONT]<>#$A THEN RES:=RES+INS[CONT];
  FILTER0A:=RES;
 END;
FUNCTION CONVERTPITOCRLF(INS:STRING):STRING;
 VAR
 CONT:WORD;
 RES:STRING;
 BEGIN
  RES:='';
  CONVERTPITOCRLF:='';
  IF LENGTH(INS)=0 THEN EXIT;
  FOR CONT:=1 TO LENGTH(INS) DO
   IF INS[CONT]<>#227 THEN RES:=RES+INS[CONT] ELSE
                           RES:=RES+#13#10;
  CONVERTPITOCRLF:=RES;
 END;
FUNCTION CONVERTCRLFTOPI(INS:STRING):STRING;
 VAR
 P1:WORD;
 RES:STRING;
 BEGIN
  RES:=INS;
  WHILE POS(#13,RES)<>0 DO
  BEGIN
   P1:=POS(#13,RES);
   DELETE(RES,P1,2);
   INSERT(#227,RES,P1);
  END;
  CONVERTCRLFTOPI:=RES;
 END;
{}
CONSTRUCTOR TQWKREADPROCESS.INIT(PATHTOQWKFILES:STRING);
VAR
CONT,CANTAREAS:WORD;
PATH,CNUM,CNAM,TMPST:STRING;
TXT:TEXT;
BEGIN
 INHERITED INIT;
 PATH:=FULLPATH(PATHTOQWKFILES);
 ASSIGN(TXT,PATH+'CONTROL.DAT');
 {$I-}RESET(TXT);{$I+}
 IF IORESULT<>0 THEN FAIL;
 READLN(TXT,NOMBREBBS);
 READLN(TXT,TMPST);READLN(TXT,TMPST);
 READLN(TXT,NOMBRESYSOP);
 READLN(TXT,BBSID);READLN(TXT,TMPST);
 BBSID:=COPY(BBSID,POS(',',BBSID)+1,LENGTH(BBSID)-POS(',',BBSID));
 READLN(TXT,NOMBREUSUARIO);
 READLN(TXT,TMPST);READLN(TXT,TMPST);READLN(TXT,TMPST);
 READLN(TXT,TMPST);CANTAREAS:=STR2LONG(TMPST);
 IF CANTAREAS=0 THEN BEGIN CLOSE(TXT);FAIL;END;
 AREALIST:=NEW(PSTRINGCOLLECTION,INIT(1,1));
 FOR CONT:=0 TO CANTAREAS-1 DO
 BEGIN
  READLN(TXT,CNUM);
  READLN(TXT,CNAM);
  AREALIST^.INSERT(NEWSTR(#1+CNUM+#2#3+CNAM+#4));
 END;
 CLOSE(TXT);
 QWKSTREAM:=NEW(PBUFSTREAM,INIT(PATH+'MESSAGES.DAT',STOPEN,1024));
 IF QWKSTREAM^.STATUS<>STOK THEN BEGIN
  DISPOSE(QWKSTREAM,DONE);
  DISPOSE(AREALIST,DONE);
  FAIL;
 END;
 QWKSTREAM^.SEEK(128);{SALTEA EL COPYRIGHT DEL QWK}
END;
FUNCTION TQWKREADPROCESS.READQWKMESSAGE(VAR HEADER:MODMSGHDR;VAR 
TEXT:PSTREAM):INTEGER;
VAR
QWKHDR:QWKHEADER;
TEMPST:STRING;
NUMRECS,CONT:WORD;
BEGIN
 QWKSTREAM^.READ(QWKHDR,SIZEOF(QWKHDR));
 IF QWKSTREAM^.STATUS<>STOK THEN BEGIN
  READQWKMESSAGE:=ERRFINPKT;
  EXIT;
 END;
 TEMPST[0]:=#6;
 MOVE(QWKHDR.NUMBLOCKS,TEMPST[1],6);
 TEMPST:=RECORTAFINAL(TEMPST);
 NUMRECS:=STR2LONG(TEMPST);
 IF NUMRECS<2 THEN BEGIN
  READQWKMESSAGE:=ERRBADQWKMSG;
  EXIT;
 END;
 WITH HEADER DO
 BEGIN
  ATRIBUTOS:=ATRLOCAL;
  
DE[0]:=#25;MOVE(QWKHDR.DE,DE[1],25);SYSTEM.DELETE(DE,POS(#0,DE),LENGTH(DE)-POS(#0,DE)+1);
  
PARA[0]:=#25;MOVE(QWKHDR.PARA,PARA[1],25);SYSTEM.DELETE(PARA,POS(#0,PARA),LENGTH(PARA)-POS(#0,PARA)+1);
  
SOBRE[0]:=#25;MOVE(QWKHDR.SOBRE,SOBRE[1],25);SYSTEM.DELETE(SOBRE,POS(#0,SOBRE),LENGTH(SOBRE)-POS(#0,SOBRE)+1);
  FECHA.DIA:=STR2LONG(COPY(QWKHDR.FECHA,4,2));
  FECHA.MES:=STR2LONG(COPY(QWKHDR.FECHA,1,2));
  FECHA.ANO:=STR2LONG(COPY(QWKHDR.FECHA,7,2));
  HORA.HORA:=STR2LONG(COPY(QWKHDR.HORA,1,2));
  HORA.MINUTO:=STR2LONG(COPY(QWKHDR.HORA,4,2));
  HORA.SEGUNDO:=00;
  AREA:=AREABADMAIL;
  FOR CONT:=0 TO AREALIST^.COUNT-1 DO
  BEGIN
   TEMPST:=PSTRING(AREALIST^.AT(CONT))^;
   IF SUBCAD(TEMPST,#1,#2)=LONG2STR(QWKHDR.AREANUM) THEN BEGIN
    AREA:=SUBCAD(TEMPST,#3,#4);
    BREAK;
   END;
  END;
 END;
 IF TEXT=NIL THEN BEGIN
  TEXT:=NEW(PWORKSTREAM,INIT(TEMPSTREAM,1024,16384,FORSIZEINMEM));
  IF TEXT^.STATUS<>STOK THEN BEGIN
   DISPOSE(TEXT,DONE);
   READQWKMESSAGE:=ERRNOMEMORY;
   EXIT;
  END;
 END;
 FOR CONT:=1 TO NUMRECS-1 DO
 BEGIN
  TEMPST[0]:=#128;
  QWKSTREAM^.READ(TEMPST[1],128);
  TEMPST:=CONVERTPITOCRLF(TEMPST);
  IF CONT=(NUMRECS-1) THEN TEMPST:=RECORTAFINAL(TEMPST);
  TEXT^.WRITE(TEMPST[1],LENGTH(TEMPST));
 END;
 {POR SER QWK,VA TODO EN 0}
 FILLCHAR(HEADER.DIRORIG,SIZEOF(HEADER.DIRORIG),0);
 FILLCHAR(HEADER.DIRDEST,SIZEOF(HEADER.DIRDEST),0);
 {}
 READQWKMESSAGE:=ERROK;
END;
DESTRUCTOR TQWKREADPROCESS.DONE;
BEGIN
 DISPOSE(AREALIST,DONE);
 DISPOSE(QWKSTREAM,DONE);
 INHERITED DONE;
END;
{}
CONSTRUCTOR 
TQWKWRITEPROCESS.INIT(PATHTOQWKFILES:STRING;BBSID:STRING);
VAR
PATH:STRING;
MODO:WORD;
BEGIN
 PATH:=FULLPATH(PATHTOQWKFILES);
 IF EXISTE(PATH+BBSID+'.MSG') THEN MODO:=STOPEN ELSE MODO:=STCREATE;
 QWKSTREAM:=NEW(PBUFSTREAM,INIT(PATH+BBSID+'.MSG',MODO,1024));
 IF MODO=STOPEN THEN QWKSTREAM^.SEEK(QWKSTREAM^.GETSIZE) ELSE
  BEGIN
   ACTUALIZAR(BBSID,128);
   QWKSTREAM^.WRITE(BBSID[1],128);
  END;
END;
FUNCTION 
TQWKWRITEPROCESS.WRITEQWKMESSAGE(MSGBASE:ABSMSGPTR;AREANUMB:WORD):INTEGER;
VAR
NUMBLOCKS:WORD;
LASTPOS,POSHEADER:LONGINT;
QWKHDR:QWKHEADER;
TEMPST:STRING;
BEGIN
 MSGBASE^.MSGSTARTUP;
 WITH QWKHDR DO
 BEGIN
  IF MSGBASE^.ISPRIV THEN STATUS:='+' ELSE STATUS:=' ';
  
TEMPST:=LONG2STR(AREANUMB);ACTUALIZAR(TEMPST,7);MOVE(TEMPST[1],MSGNUM,7);
  
TEMPST:=MSGBASE^.GETDATE;ACTUALIZAR(TEMPST,8);MOVE(TEMPST[1],FECHA,8);
  
TEMPST:=MSGBASE^.GETTIME;ACTUALIZAR(TEMPST,5);MOVE(TEMPST[1],HORA,5);
  TEMPST:=MSGBASE^.GETTO;IF LENGTH(TEMPST)>25 THEN 
ACTUALIZAR(TEMPST,25);TEMPST:=MAYUSMINUS(TRUE,TEMPST);
  FILLCHAR(PARA,25,0);MOVE(TEMPST[1],PARA,LENGTH(TEMPST));
  TEMPST:=MSGBASE^.GETFROM;IF LENGTH(TEMPST)>25 THEN 
ACTUALIZAR(TEMPST,25);TEMPST:=MAYUSMINUS(TRUE,TEMPST);
  FILLCHAR(DE,25,0);MOVE(TEMPST[1],DE,LENGTH(TEMPST));
  TEMPST:=MSGBASE^.GETSUBJ;IF LENGTH(TEMPST)>25 THEN 
ACTUALIZAR(TEMPST,25);
  FILLCHAR(SOBRE,25,0);MOVE(TEMPST[1],SOBRE,LENGTH(TEMPST));
  FILLCHAR(PASSWORD,12,0);
  FILLCHAR(REFER,8,#32);REFER[1]:='0';
  POSHEADER:=QWKSTREAM^.GETPOS;
  ACTIVO:=#225;
  AREANUM:=AREANUMB;
  FILLCHAR(FILL,2,0);
  HASTAG:=' ';
 END;
 QWKSTREAM^.WRITE(QWKHDR,SIZEOF(QWKHDR));
 NUMBLOCKS:=SIZEOF(QWKHDR);
 MSGBASE^.MSGTXTSTARTUP;
 TEMPST:=MSGBASE^.GETSTRING(ANCHOMENSAJE);
 WHILE NOT MSGBASE^.EOM DO
 BEGIN
  TEMPST:=FILTER0A(TEMPST)+#$D;
  TEMPST:=CONVERTCRLFTOPI(TEMPST);
  QWKSTREAM^.WRITE(TEMPST[1],LENGTH(TEMPST));
  INC(NUMBLOCKS,LENGTH(TEMPST));
  TEMPST:=MSGBASE^.GETSTRING(ANCHOMENSAJE);
 END;
 IF ((NUMBLOCKS DIV 128)+1)<2 THEN BEGIN
  QWKSTREAM^.SEEK(POSHEADER);
  QWKSTREAM^.TRUNCATE;
 END ELSE
 BEGIN
  IF (NUMBLOCKS MOD 128)>0 THEN BEGIN
   ACTUALIZAR(TEMPST,128-(NUMBLOCKS MOD 128));
   QWKSTREAM^.WRITE(TEMPST[1],LENGTH(TEMPST));
  END;
  TEMPST:=LONG2STR((NUMBLOCKS DIV 128)+1);ACTUALIZAR(TEMPST,6);
  MOVE(TEMPST[1],QWKHDR.NUMBLOCKS,6);
  LASTPOS:=QWKSTREAM^.GETPOS;
  QWKSTREAM^.SEEK(POSHEADER);
  QWKSTREAM^.WRITE(QWKHDR,SIZEOF(QWKHDR));
  QWKSTREAM^.SEEK(LASTPOS);
 END;
 WRITEQWKMESSAGE:=ERROK;
END;
DESTRUCTOR TQWKWRITEPROCESS.DONE;
BEGIN
 DISPOSE(QWKSTREAM,DONE);
 INHERITED DONE;
END;
{}
CONSTRUCTOR 
TPACKETWRITEPROCESS.INIT(PKTFILE:STRING;HDRDATA:MODPKTHDR;OVERWRITEHDR:BOOLEAN);
VAR
H,MI,S,C,D,M,A,DW,MODO:WORD;
PKTHDR:ORIGPKTHDR;
BEGIN
 INHERITED INIT;
 IF NOT EXISTE(PKTFILE) THEN MODO:=STCREATE ELSE MODO:=STOPEN;
 PKTSTREAM:=NEW(PBUFSTREAM,INIT(PKTFILE,MODO,1024));
 GETDATE(A,M,D,DW);
 GETTIME(H,MI,S,C);
 WITH PKTHDR DO
 BEGIN
  ONODE:=HDRDATA.ODIR.NODE;DNODE:=HDRDATA.DDIR.NODE;
  ANO:=A;MES:=M;DIA:=D;
  HORA:=H;MINUTO:=MI;SEGUNDO:=S;
  BAUDIOS:=BAUDIOSPKT;
  TIPOPAQUETE:=TIPOPKT;
  ONET:=HDRDATA.ODIR.NET;DNET:=HDRDATA.DDIR.NET;
  CODPH:=HI(PRODUCTCODE);REVH:=HI(VERSION);
  FILLCHAR(PASSWORD,SIZEOF(PASSWORD),0);
  MOVE(HDRDATA.CLAVE[1],PASSWORD,LENGTH(HDRDATA.CLAVE));
  OZONE1:=HDRDATA.ODIR.ZONE;DZONE1:=HDRDATA.DDIR.ZONE;
  AUXNET:=0;
  CWORD:=VALORCAPWORD;
  CODPL:=LO(PRODUCTCODE);REVL:=LO(VERSION);
  CWORDCOPY:=VALORCAPWORDCOPY;
  OZONE2:=OZONE1;DZONE2:=DZONE1;
  OPOINT:=HDRDATA.ODIR.POINT;DPOINT:=HDRDATA.DDIR.POINT;
  FILLCHAR(SPECDATA,SIZEOF(SPECDATA),0);
 END;
 IF ((MODO=STOPEN) AND (OVERWRITEHDR)) OR
    (MODO=STCREATE) THEN PKTSTREAM^.WRITE(PKTHDR,SIZEOF(PKTHDR));
 IF (MODO=STOPEN) THEN PKTSTREAM^.SEEK(PKTSTREAM^.GETSIZE-2);
END;
FUNCTION 
TPACKETWRITEPROCESS.WRITEPKTMESSAGE(AREA:STRING;MSGBASE:ABSMSGPTR):INTEGER;
VAR
MSGHDR:ORIGMSGHDR;
DIR:ADDRTYPE;
AREASTR,TEMPSTR,MES,RESFECHA,FECHASTR:STRING;
BEGIN
 WITH MSGHDR DO
 BEGIN
  MSGBASE^.MSGSTARTUP;
  MSGID:=TIPOPKT;
  MSGBASE^.GETORIG(DIR);
  ONODE:=DIR.NODE;ONET:=DIR.NET;
  MSGBASE^.GETDEST(DIR);
  DNODE:=DIR.NODE;DNET:=DIR.NET;
  ATR:=0;
  IF MSGBASE^.ISLOCAL THEN ATR:=ATR OR ATRLOCAL;
  IF MSGBASE^.ISCRASH THEN ATR:=ATR OR ATRCRASH;
  IF MSGBASE^.ISKILLSENT THEN ATR:=ATR OR ATRBORRARENVIADO;
  IF MSGBASE^.ISSENT THEN ATR:=ATR OR ATRENVIADO;
  IF MSGBASE^.ISFATTACH THEN ATR:=ATR OR ATRFILEATTACH;
  IF MSGBASE^.ISREQRCT THEN ATR:=ATR OR ATRPEDIRRECIBIDO;
  IF MSGBASE^.ISREQAUD THEN ATR:=ATR OR ATREXAMINARPEDIDO;
  IF MSGBASE^.ISRETRCT THEN ATR:=ATR OR ATRRETORNARRECIBIDO;
  IF MSGBASE^.ISFILEREQ THEN ATR:=ATR OR ATRFILEREQUEST;
  IF MSGBASE^.ISRCVD THEN ATR:=ATR OR ATRRECIBIDO;
  IF MSGBASE^.ISPRIV THEN ATR:=ATR OR ATRPRIVADO;
  COSTO:=COSTOMENSAJE;
  FECHASTR:=MSGBASE^.GETDATE;
  RESFECHA:=COPY(FECHASTR,4,2);
  MES:=COPY(FECHASTR,1,2);
  IF MES='01' THEN RESFECHA:=RESFECHA+' Jan';
  IF MES='02' THEN RESFECHA:=RESFECHA+' Feb';
  IF MES='03' THEN RESFECHA:=RESFECHA+' Mar';
  IF MES='04' THEN RESFECHA:=RESFECHA+' Apr';
  IF MES='05' THEN RESFECHA:=RESFECHA+' May';
  IF MES='06' THEN RESFECHA:=RESFECHA+' Jun';
  IF MES='07' THEN RESFECHA:=RESFECHA+' Jul';
  IF MES='08' THEN RESFECHA:=RESFECHA+' Aug';
  IF MES='09' THEN RESFECHA:=RESFECHA+' Sep';
  IF MES='10' THEN RESFECHA:=RESFECHA+' Oct';
  IF MES='11' THEN RESFECHA:=RESFECHA+' Nov';
  IF MES='12' THEN RESFECHA:=RESFECHA+' Dec';
  RESFECHA:=RESFECHA+' '+COPY(FECHASTR,7,2)+'  '+MSGBASE^.GETTIME;
  FILLCHAR(FECHA,SIZEOF(FECHA),0);
  MOVE(RESFECHA[1],FECHA,LENGTH(RESFECHA));
 END;
 PKTSTREAM^.WRITE(MSGHDR,SIZEOF(MSGHDR));
 
TEMPSTR:=MSGBASE^.GETTO+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 
TEMPSTR:=MSGBASE^.GETFROM+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 
TEMPSTR:=MSGBASE^.GETSUBJ+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 IF AREA<>'' THEN BEGIN
  AREASTR:=AREAKLUDGE+AREA+#13;
  PKTSTREAM^.WRITE(AREASTR[1],LENGTH(AREASTR));
 END;
 MSGBASE^.MSGTXTSTARTUP;
 TEMPSTR:=MSGBASE^.GETSTRING(ANCHOMENSAJE);
 WHILE NOT MSGBASE^.EOM DO
 BEGIN
  TEMPSTR:=FILTER0A(TEMPSTR)+#$D;
  PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
  TEMPSTR:=MSGBASE^.GETSTRING(ANCHOMENSAJE);
 END;
 PKTSTREAM^.WRITE(ENDOFMSG,LENGTH(ENDOFMSG));
END;
FUNCTION 
TPACKETWRITEPROCESS.WRITEPKTFROMBUFFER(HDR:MODMSGHDR;TEXT:PSTREAM):INTEGER;
VAR
MSGHDR:ORIGMSGHDR;
DIR:ADDRTYPE;
AREASTR,D,M,A,S,H,TEMPSTR,MES,RESFECHA,FECHASTR:STRING;
BEGIN
 WITH MSGHDR DO
 BEGIN
  MSGID:=TIPOPKT;
  ONODE:=HDR.DIRORIG.NODE;ONET:=HDR.DIRORIG.NET;
  DNODE:=HDR.DIRDEST.NODE;DNET:=HDR.DIRDEST.NET;
  ATR:=HDR.ATRIBUTOS;
  COSTO:=COSTOMENSAJE;
  
D:=LONG2STR(HDR.FECHA.DIA);M:=LONG2STR(HDR.FECHA.MES);A:=LONG2STR(HDR.FECHA.ANO);
  INSERTAAD('0',D,2);INSERTAAD('0',M,2);
  FECHASTR:=M+'/'+D+'/'+A;
  RESFECHA:=COPY(FECHASTR,4,2);
  MES:=COPY(FECHASTR,1,2);
  IF MES='01' THEN RESFECHA:=RESFECHA+' Jan';
  IF MES='02' THEN RESFECHA:=RESFECHA+' Feb';
  IF MES='03' THEN RESFECHA:=RESFECHA+' Mar';
  IF MES='04' THEN RESFECHA:=RESFECHA+' Apr';
  IF MES='05' THEN RESFECHA:=RESFECHA+' May';
  IF MES='06' THEN RESFECHA:=RESFECHA+' Jun';
  IF MES='07' THEN RESFECHA:=RESFECHA+' Jul';
  IF MES='08' THEN RESFECHA:=RESFECHA+' Aug';
  IF MES='09' THEN RESFECHA:=RESFECHA+' Sep';
  IF MES='10' THEN RESFECHA:=RESFECHA+' Oct';
  IF MES='11' THEN RESFECHA:=RESFECHA+' Nov';
  IF MES='12' THEN RESFECHA:=RESFECHA+' Dec';
  
H:=LONG2STR(HDR.HORA.HORA);M:=LONG2STR(HDR.HORA.MINUTO);S:=LONG2STR(HDR.HORA.SEGUNDO);
  INSERTAAD('0',H,2);INSERTAAD('0',M,2);INSERTAAD('0',S,2);
  RESFECHA:=RESFECHA+' '+COPY(FECHASTR,7,2)+'  '+H+':'+M+':'+S;
  FILLCHAR(FECHA,SIZEOF(FECHA),0);
  MOVE(RESFECHA[1],FECHA,LENGTH(RESFECHA));
 END;
 PKTSTREAM^.WRITE(MSGHDR,SIZEOF(MSGHDR));
 TEMPSTR:=HDR.PARA+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 TEMPSTR:=HDR.DE+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 TEMPSTR:=HDR.SOBRE+#0;PKTSTREAM^.WRITE(TEMPSTR[1],LENGTH(TEMPSTR));
 IF HDR.AREA<>'' THEN BEGIN
  AREASTR:=AREAKLUDGE+HDR.AREA+#13;
  PKTSTREAM^.WRITE(AREASTR[1],LENGTH(AREASTR));
 END;
 PKTSTREAM^.COPYFROM(TEXT^,TEXT^.GETSIZE-TEXT^.GETPOS);
 PKTSTREAM^.WRITE(ENDOFMSG,LENGTH(ENDOFMSG));
END;
DESTRUCTOR TPACKETWRITEPROCESS.DONE;
BEGIN
 PKTSTREAM^.SEEK(PKTSTREAM^.GETSIZE);
 PKTSTREAM^.WRITE(ENDOFPACKET,2);
 DISPOSE(PKTSTREAM,DONE);
 INHERITED DONE;
END;
{}
CONSTRUCTOR TPACKETREADPROCESS.INIT(PKTFILE:STRING);
BEGIN
 INHERITED INIT;
 PKTSTREAM:=NEW(PBUFSTREAM,INIT(PKTFILE,STOPEN,1024));
 IF PKTSTREAM^.STATUS<>STOK THEN BEGIN
  DISPOSE(PKTSTREAM,DONE);
  FAIL;
 END;
 PKTSTREAM^.READ(PKTHEADER,SIZEOF(PKTHEADER));
 PKTHEADER.CWORDCOPY:=(LO(PKTHEADER.CWORDCOPY) SHL 8) OR 
HI(PKTHEADER.CWORDCOPY);
END;
PROCEDURE TPACKETREADPROCESS.GETPKTORIGADDRESS(VAR DIR:ADDRTYPE);
BEGIN
 FILLCHAR(DIR,SIZEOF(DIR),0);
 WITH PKTHEADER DO
 BEGIN
  IF TIPOPAQUETE<>2 THEN EXIT;
  IF (CWORD=CWORDCOPY) AND (CWORD<>0) AND (CWORD=256) THEN BEGIN
    IF (OPOINT<>0) AND (ONET=-1) THEN ONET:=AUXNET;
    DIR.ZONE:=OZONE1;
    DIR.NET:=ONET;
    DIR.NODE:=ONODE;
    DIR.POINT:=OPOINT;
  END ELSE BEGIN
    DIR.ZONE:=0;
    DIR.NET:=ONET;
    DIR.NODE:=ONODE;
    DIR.POINT:=OPOINT;
  END;
 END;
END;
PROCEDURE TPACKETREADPROCESS.GETPKTDESTADDRESS(VAR DIR:ADDRTYPE);
BEGIN
 FILLCHAR(DIR,SIZEOF(DIR),0);
 WITH PKTHEADER DO
 BEGIN
  IF TIPOPAQUETE<>2 THEN EXIT;
  IF (CWORD=CWORDCOPY) AND (CWORD<>0) AND (CWORD=256) THEN BEGIN
    IF (DPOINT<>0) AND (DNET=-1) THEN DNET:=AUXNET;
    DIR.ZONE:=DZONE1;
    DIR.NET:=DNET;
    DIR.NODE:=DNODE;
    DIR.POINT:=DPOINT;
  END ELSE BEGIN
    DIR.ZONE:=0;
    DIR.NET:=DNET;
    DIR.NODE:=DNODE;
    DIR.POINT:=DPOINT;
  END;
 END;
END;
FUNCTION TPACKETREADPROCESS.READPKTMESSAGE(VAR HEADER:MODMSGHDR;VAR 
TEXT:PSTREAM):INTEGER;
CONST
TAMBUF=1023;
TYPE
 TBUFTYPE=ARRAY[0..TAMBUF] OF CHAR;
 PBUFTYPE=^TBUFTYPE;
VAR
BUFSIZE:WORD;
TEXTSTREAM:PSTREAM;
POSCR,POSBUSQ,READSIZE:WORD;
FINDMSGID,FIRSTBLOCK,FINTEXTO:BOOLEAN;
TEMPBUF:POINTER;
RESTSIZE,RESTPOS:LONGINT;
BEGIN
 FILLCHAR(HEADER,SIZEOF(HEADER),0);
 CASE GETMSGHEADER(HEADER) OF
  ERRFINPKT:BEGIN READPKTMESSAGE:=ERRFINPKT;EXIT;END;
 END;
 IF TEXT=NIL THEN BEGIN
  TEXT:=NEW(PWORKSTREAM,INIT(TEMPSTREAM,1024,16384,FORSPEED));
   IF TEXT^.STATUS<>STOK THEN BEGIN
    DISPOSE(TEXT,DONE);
    READPKTMESSAGE:=ERRNOMEMORY;
    EXIT;
   END;
 END;
 GETMEM(TEMPBUF,TAMBUF);
 IF TEMPBUF=NIL THEN
 BEGIN
  READPKTMESSAGE:=ERRNOMEMORY;
  EXIT;
 END;
 FINTEXTO:=FALSE;
 FIRSTBLOCK:=TRUE;
 RESTSIZE:=PKTSTREAM^.GETSIZE-PKTSTREAM^.GETPOS;
 WHILE NOT FINTEXTO DO
 BEGIN
  IF TAMBUF>RESTSIZE THEN BUFSIZE:=RESTSIZE ELSE
                          BUFSIZE:=TAMBUF;
  PKTSTREAM^.READ(TEMPBUF^,BUFSIZE);
  DEC(RESTSIZE,BUFSIZE);
  IF FIRSTBLOCK THEN BEGIN
   FIRSTBLOCK:=FALSE;
   POSBUSQ:=SCANBUFFER(TEMPBUF^,BUFSIZE,AREAKLUDGE);
   IF POSBUSQ<$FFFF THEN BEGIN
    INC(POSBUSQ,LENGTH(AREAKLUDGE));
    POSCR:=SCANBUFFER(TEMPBUF^,BUFSIZE,#13);
    MOVE(PBUFTYPE(TEMPBUF)^[POSBUSQ],HEADER.AREA[1],POSCR-POSBUSQ);
    HEADER.AREA[0]:=CHR(POSCR-POSBUSQ);
    {}
     DEC(POSBUSQ,LENGTH(AREAKLUDGE));
     DEC(BUFSIZE,(POSCR-POSBUSQ)+1);
     MOVE(PBUFTYPE(TEMPBUF)^[POSCR+POSBUSQ+1],TEMPBUF^,BUFSIZE);
    {}
   END;
  END;
  POSBUSQ:=SCANBUFFER(TEMPBUF^,BUFSIZE,#0);
  IF POSBUSQ<$FFFF THEN
     BEGIN
      IF POSBUSQ>0 THEN TEXT^.WRITE(TEMPBUF^,POSBUSQ-1);
      TEXT^.TRUNCATE;
      RESTPOS:=BUFSIZE-POSBUSQ-1;
      PKTSTREAM^.SEEK(PKTSTREAM^.GETPOS-RESTPOS);
      FINTEXTO:=TRUE;
     END ELSE TEXT^.WRITE(TEMPBUF^,BUFSIZE);
 END;
 FREEMEM(TEMPBUF,TAMBUF);
 HEADER.AREA:=MAYUSMINUS(TRUE,HEADER.AREA);
 READPKTMESSAGE:=ERROK;
END;
FUNCTION TPACKETREADPROCESS.GETSTRINGTONULL:STRING;
VAR
RES:STRING;
C:CHAR;
BEGIN
 PKTSTREAM^.READ(C,1);
 RES:='';
 WHILE C<>#0 DO
 BEGIN
 RES:=RES+C;
  PKTSTREAM^.READ(C,1);
 END;
 GETSTRINGTONULL:=RES;
END;
FUNCTION TPACKETREADPROCESS.GETMSGHEADER(VAR HDR:MODMSGHDR):INTEGER;
VAR
TEMPFECHA:STRING;
SD,SM,SA,SFECHA,SHORA:STRING;
OHDR:ORIGMSGHDR;
BEGIN
 PKTSTREAM^.READ(OHDR,SIZEOF(OHDR));
 IF PKTSTREAM^.STATUS<>STOK THEN BEGIN 
GETMSGHEADER:=ERRFINPKT;EXIT;END;
 FILLCHAR(HDR,SIZEOF(HDR),0);
 HDR.DIRORIG.NODE:=OHDR.ONODE;
 HDR.DIRORIG.NET:=OHDR.ONET;
 HDR.DIRDEST.NODE:=OHDR.DNODE;
 HDR.DIRDEST.NET:=OHDR.DNET;
 HDR.ATRIBUTOS:=OHDR.ATR;
 TEMPFECHA[0]:=#20;
 MOVE(OHDR.FECHA[1],TEMPFECHA[1],20);
 TEMPFECHA:=RECORTAFINAL(TEMPFECHA);
 SFECHA:=COPY(TEMPFECHA,1,9);
 SHORA:=COPY(TEMPFECHA,12,8);
 SD:=COPY(SFECHA,1,2);HDR.FECHA.DIA:=STR2LONG(SD);
 SM:=COPY(SFECHA,4,3);SM:=MAYUSMINUS(TRUE,SM);
 IF SM='JAN' THEN HDR.FECHA.MES:=1;
 IF SM='FEB' THEN HDR.FECHA.MES:=2;
 IF SM='MAR' THEN HDR.FECHA.MES:=3;
 IF SM='APR' THEN HDR.FECHA.MES:=4;
 IF SM='MAY' THEN HDR.FECHA.MES:=5;
 IF SM='JUN' THEN HDR.FECHA.MES:=6;
 IF SM='JUL' THEN HDR.FECHA.MES:=7;
 IF SM='AUG' THEN HDR.FECHA.MES:=8;
 IF SM='SEP' THEN HDR.FECHA.MES:=9;
 IF SM='OCT' THEN HDR.FECHA.MES:=10;
 IF SM='NOV' THEN HDR.FECHA.MES:=11;
 IF SM='DEC' THEN HDR.FECHA.MES:=12;
 SA:=COPY(SFECHA,8,2);HDR.FECHA.ANO:=STR2LONG(SA);
 HDR.HORA.HORA:=STR2LONG(COPY(SHORA,1,2));
 HDR.HORA.MINUTO:=STR2LONG(COPY(SHORA,4,2));
 HDR.HORA.SEGUNDO:=STR2LONG(COPY(SHORA,7,2));
 HDR.PARA:=GETSTRINGTONULL;
 HDR.DE:=GETSTRINGTONULL;
 HDR.SOBRE:=GETSTRINGTONULL;
 GETMSGHEADER:=ERROK;
END;
DESTRUCTOR TPACKETREADPROCESS.DONE;
BEGIN
 DISPOSE(PKTSTREAM,DONE);
 INHERITED DONE;
END;
{}
PROCEDURE GETORIGADDRESS(PKT:STRING;VAR ADR:ADDRTYPE);
VAR
PKTR:PPACKETREADPROCESS;
BEGIN
 FILLCHAR(ADR,SIZEOF(ADR),0);
 PKTR:=NEW(PPACKETREADPROCESS,INIT(PKT));
 IF PKTR=NIL THEN EXIT;
 PKTR^.GETPKTORIGADDRESS(ADR);
 DISPOSE(PKTR,DONE);
END;
PROCEDURE GETDESTADDRESS(PKT:STRING;VAR ADR:ADDRTYPE);
VAR
PKTR:PPACKETREADPROCESS;
BEGIN
 FILLCHAR(ADR,SIZEOF(ADR),0);
 PKTR:=NEW(PPACKETREADPROCESS,INIT(PKT));
 IF PKTR=NIL THEN EXIT;
 PKTR^.GETPKTDESTADDRESS(ADR);
 DISPOSE(PKTR,DONE);
END;
END.