[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]
{
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.
[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]