1222 lines
33 KiB
Plaintext
1222 lines
33 KiB
Plaintext
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-}
|
|||
|
|
|
|||
|
|
UNIT OffLine;
|
|||
|
|
|
|||
|
|
INTERFACE
|
|||
|
|
|
|||
|
|
PROCEDURE SetMessageAreaNewScanDate;
|
|||
|
|
PROCEDURE DownloadPacket;
|
|||
|
|
PROCEDURE uploadpacket(Already: Boolean);
|
|||
|
|
|
|||
|
|
IMPLEMENTATION
|
|||
|
|
|
|||
|
|
USES
|
|||
|
|
Crt,
|
|||
|
|
Dos,
|
|||
|
|
Common,
|
|||
|
|
Archive1,
|
|||
|
|
ExecBat,
|
|||
|
|
File0,
|
|||
|
|
File1,
|
|||
|
|
File2,
|
|||
|
|
File8,
|
|||
|
|
File11,
|
|||
|
|
Mail0,
|
|||
|
|
Mail1,
|
|||
|
|
Mail2,
|
|||
|
|
Mail4,
|
|||
|
|
NodeList,
|
|||
|
|
TimeFunc;
|
|||
|
|
|
|||
|
|
TYPE
|
|||
|
|
BSingle = ARRAY [0..3] OF Byte;
|
|||
|
|
|
|||
|
|
NDXRec = RECORD
|
|||
|
|
Pointer: BSingle;
|
|||
|
|
Conf: Byte;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
QWKHeadeRec = RECORD
|
|||
|
|
Flag: Char;
|
|||
|
|
Num: ARRAY [1..7] OF Char;
|
|||
|
|
MsgDate: ARRAY [1..8] OF Char;
|
|||
|
|
MsgTime: ARRAY [1..5] OF Char;
|
|||
|
|
MsgTo: ARRAY [1..25] OF Char;
|
|||
|
|
MsgFrom: ARRAY [1..25] OF Char;
|
|||
|
|
MsgSubj: ARRAY [1..25] OF Char;
|
|||
|
|
MsgPWord: STRING[11];
|
|||
|
|
RNum: STRING[7];
|
|||
|
|
NumBlocks: ARRAY [1..6] OF Char;
|
|||
|
|
Status: Byte;
|
|||
|
|
MBase: Word;
|
|||
|
|
Crap: STRING[3];
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
(*
|
|||
|
|
PROCEDURE SetFileAreaNewScanDate;
|
|||
|
|
VAR
|
|||
|
|
TempDate: Str10;
|
|||
|
|
Key: CHAR;
|
|||
|
|
BEGIN
|
|||
|
|
{
|
|||
|
|
NL;
|
|||
|
|
Prt(FString.FileNewScan);
|
|||
|
|
}
|
|||
|
|
lRGLngStr(54,FALSE);
|
|||
|
|
MPL(10);
|
|||
|
|
Prompt(PD2Date(NewDate));
|
|||
|
|
Key := Char(GetKey);
|
|||
|
|
IF (Key = #13) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
TempDate := PD2Date(NewDate);
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
Buf := Key;
|
|||
|
|
DOBackSpace(1,10);
|
|||
|
|
InputFormatted('',TempDate,'##/##/####',TRUE);
|
|||
|
|
IF (TempDate = '') THEN
|
|||
|
|
TempDate := PD2Date(NewDate);
|
|||
|
|
END;
|
|||
|
|
IF (DayNum(TempDate) = 0) OR (DayNum(TempDate) > DayNum(DateStr)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('Invalid date entered.');
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('New file scan date set to: ^5'+TempDate+'^1');
|
|||
|
|
NewDate := Date2PD(TempDate);
|
|||
|
|
SL1('Reset file new scan date to: ^5'+TempDate+'.');
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
*)
|
|||
|
|
|
|||
|
|
PROCEDURE SetMessageAreaNewScanDate;
|
|||
|
|
VAR
|
|||
|
|
S: AStr;
|
|||
|
|
DT: DateTime;
|
|||
|
|
MArea,
|
|||
|
|
SaveMsgArea: Integer;
|
|||
|
|
l: LongInt;
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Prt('Enter oldest date for new messages (mm/dd/yyyy): ');
|
|||
|
|
|
|||
|
|
InputFormatted('',S,'##/##/####',TRUE);
|
|||
|
|
IF (DayNum(S) = 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('^7Invalid date entered!^1')
|
|||
|
|
END
|
|||
|
|
ELSE IF (S <> '') THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('Current newscan date is now: ^5'+S);
|
|||
|
|
SaveMsgArea := MsgArea;
|
|||
|
|
FillChar(DT,SizeOf(DT),0);
|
|||
|
|
WITH DT DO
|
|||
|
|
BEGIN
|
|||
|
|
Month := StrToInt(Copy(S,1,2));
|
|||
|
|
Day := StrToInt(Copy(S,4,2));
|
|||
|
|
Year := StrToInt(Copy(S,7,4));
|
|||
|
|
END;
|
|||
|
|
l := DateToPack(DT);
|
|||
|
|
FOR MArea := 1 TO NumMsgAreas DO
|
|||
|
|
BEGIN
|
|||
|
|
InitMsgArea(MArea);
|
|||
|
|
LastReadRecord.LastRead := L;
|
|||
|
|
SaveLastReadRecord(LastReadRecord);
|
|||
|
|
END;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
SL1('Reset message last read pointers.');
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
PROCEDURE DownloadPacket;
|
|||
|
|
VAR
|
|||
|
|
IndexR:
|
|||
|
|
NDXRec;
|
|||
|
|
NDXFile,
|
|||
|
|
PNDXFile: FILE OF NDXRec;
|
|||
|
|
MsgFile: FILE;
|
|||
|
|
ControlTxt: Text;
|
|||
|
|
MHeader: MHeaderRec;
|
|||
|
|
QWKHeader: QWKHeadeRec;
|
|||
|
|
DT: DateTime;
|
|||
|
|
TransferFlags: TransferFlagSet;
|
|||
|
|
S,
|
|||
|
|
Texts: STRING;
|
|||
|
|
|
|||
|
|
C: Char;
|
|||
|
|
|
|||
|
|
FArrayRecNum: Byte;
|
|||
|
|
|
|||
|
|
MArea,
|
|||
|
|
UseMsgArea,
|
|||
|
|
AvailableMsgAreas,
|
|||
|
|
SaveMsgArea,
|
|||
|
|
SaveFileArea: Integer;
|
|||
|
|
|
|||
|
|
|
|||
|
|
TotalNewMsgsInArea,
|
|||
|
|
TotalYourMsgsInArea,
|
|||
|
|
MsgNum,
|
|||
|
|
TempTextSize: Word;
|
|||
|
|
|
|||
|
|
X,
|
|||
|
|
LastK,
|
|||
|
|
Marker,
|
|||
|
|
TotalMsgsAllAreas,
|
|||
|
|
TotalNewMsgsAllAreas,
|
|||
|
|
TotalYourMsgsAllAreas,
|
|||
|
|
LastUpdate: LongInt;
|
|||
|
|
|
|||
|
|
SaveConfSystem,
|
|||
|
|
Ok: Boolean;
|
|||
|
|
|
|||
|
|
PROCEDURE Real_To_Msb(PReal: Real; VAR B: BSingle);
|
|||
|
|
VAR
|
|||
|
|
R: ARRAY [0 .. 5] OF Byte ABSOLUTE PReal;
|
|||
|
|
BEGIN
|
|||
|
|
B[3] := R[0];
|
|||
|
|
Move(R[3],B[0],3);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
PROCEDURE KillEmail;
|
|||
|
|
VAR
|
|||
|
|
MsgNum1: Word;
|
|||
|
|
BEGIN
|
|||
|
|
InitMsgArea(-1);
|
|||
|
|
Reset(MsgHdrF);
|
|||
|
|
IF (IOResult = 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
FOR MsgNum1 := 1 TO FileSize(MsgHdrF) DO
|
|||
|
|
BEGIN
|
|||
|
|
Seek(MsgHdrF,(MsgNum1 - 1));
|
|||
|
|
Read(MsgHdrF,MHeader);
|
|||
|
|
IF ToYou(MHeader) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Include(MHeader.Status,MDeleted);
|
|||
|
|
Seek(MsgHdrF,(MsgNum1 - 1));
|
|||
|
|
Write(MsgHdrF,MHeader);
|
|||
|
|
END
|
|||
|
|
END;
|
|||
|
|
Close(MsgHdrF);
|
|||
|
|
END;
|
|||
|
|
ThisUser.Waiting := 0;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
PROCEDURE Upload_Display;
|
|||
|
|
BEGIN
|
|||
|
|
LastUpdate := Timer;
|
|||
|
|
IF (NOT Abort) THEN
|
|||
|
|
Prompt(' <13>'+PadRightInt(TotalNewMsgsInArea,7)+
|
|||
|
|
'<13>'+PadRightInt(TotalYourMsgsInArea,6)+
|
|||
|
|
'<13>'+PadRightStr(IntToStr((FileSize(MsgFile) - LastK) DIV 1024)+'k',8));
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
PROCEDURE UpdatePointers;
|
|||
|
|
VAR
|
|||
|
|
MArea1: Integer;
|
|||
|
|
MsgNum1: Word;
|
|||
|
|
BEGIN
|
|||
|
|
TotalNewMsgsAllAreas := 0;
|
|||
|
|
FOR MArea1 := 1 TO NumMsgAreas DO
|
|||
|
|
IF (CompMsgArea(MArea1,0) <> 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
InitMsgArea(MArea1);
|
|||
|
|
IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR (MAForceRead IN MemMsgArea.MAFlags)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
LastError := IOResult;
|
|||
|
|
Reset(MsgHdrF);
|
|||
|
|
IF (IOResult = 2) THEN
|
|||
|
|
ReWrite(MsgHdrF);
|
|||
|
|
MsgNum1 := FirstNew;
|
|||
|
|
IF (MsgNum1 > 0) THEN
|
|||
|
|
TotalNewMsgsInArea := FileSize(MsgHdrF) - MsgNum1 + 1
|
|||
|
|
ELSE
|
|||
|
|
TotalNewMsgsInArea := 0;
|
|||
|
|
MsgNum1 := FileSize(MsgHdrF);
|
|||
|
|
IF (TotalNewMsgsAllAreas + TotalNewMsgsInArea > General.MaxQWKTotal) THEN
|
|||
|
|
MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + (General.MaxQWKtotal - TotalNewMsgsAllAreas);
|
|||
|
|
IF (TotalNewMsgsInArea > general.maxqwkbase) AND
|
|||
|
|
(((FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase) < MsgNum1) THEN
|
|||
|
|
MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase;
|
|||
|
|
Seek(MsgHdrF,MsgNum1- 1);
|
|||
|
|
Read(MsgHdrF,MHeader);
|
|||
|
|
LoadLastReadRecord(LastReadRecord);
|
|||
|
|
LastReadRecord.LastRead := MHeader.Date;
|
|||
|
|
SaveLastReadRecord(LastReadRecord);
|
|||
|
|
Inc(TotalNewMsgsAllAreas, MsgNum1 - (FileSize(MsgHdrF) - TotalNewMsgsInArea));
|
|||
|
|
Close(MsgHdrF);
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
IF (ThisUser.DefArcType < 1) OR (ThisUser.DefArcType > MaxArcs) OR
|
|||
|
|
(NOT General.FileArcInfo[ThisUser.DefArcType].Active) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Print('Please select an archive type first.');
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (MakeQWKFor > 0) OR (Exist(TempDir+'QWK\'+General.PacketName+'QWK') AND
|
|||
|
|
PYNQ('Create a new QWK packet for download? ',0,FALSE)) THEN
|
|||
|
|
PurgeDir(TempDir+'QWK\',FALSE)
|
|||
|
|
ELSE
|
|||
|
|
PurgeDir(TempDir+'QWK\',FALSE);
|
|||
|
|
|
|||
|
|
SaveMsgArea := MsgArea;
|
|||
|
|
|
|||
|
|
SaveConfSystem := ConfSystem;
|
|||
|
|
ConfSystem := FALSE;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
|
|||
|
|
OffLineMail := TRUE;
|
|||
|
|
|
|||
|
|
IF (NOT Exist(TempDir+'QWK\'+General.PacketName+'QWK')) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Assign(ControlTxt,TempDir+'QWK\CONTROL.DAT');
|
|||
|
|
ReWrite(ControlTxt);
|
|||
|
|
WriteLn(ControlTxt,StripColor(General.BBSName));
|
|||
|
|
WriteLn(ControlTxt);
|
|||
|
|
WriteLn(ControlTxt,General.BBSPhone);
|
|||
|
|
WriteLn(ControlTxt,General.SysOpName,', Sysop');
|
|||
|
|
WriteLn(ControlTxt,'0,'+General.PacketName);
|
|||
|
|
WriteLn(ControlTxt,Copy(DateStr,1,2)+'-'+Copy(DateStr,4,2)+'-'+Copy(DateStr,7,4)+','+TimeStr);
|
|||
|
|
WriteLn(ControlTxt,ThisUser.Name);
|
|||
|
|
WriteLn(ControlTxt);
|
|||
|
|
WriteLn(ControlTxt,'0');
|
|||
|
|
WriteLn(ControlTxt,'0');
|
|||
|
|
|
|||
|
|
AvailableMsgAreas := 1;
|
|||
|
|
|
|||
|
|
FOR MArea := 1 TO NumMsgAreas DO
|
|||
|
|
IF MsgAreaAC(MArea) THEN
|
|||
|
|
Inc(AvailableMsgAreas);
|
|||
|
|
|
|||
|
|
WriteLn(ControlTxt,(AvailableMsgAreas - 1));
|
|||
|
|
|
|||
|
|
FOR MArea := -1 TO NumMsgAreas DO
|
|||
|
|
IF (MArea > 0) AND MsgAreaAC(MArea) THEN
|
|||
|
|
BEGIN
|
|||
|
|
WriteLn(ControlTxt,MemMsgArea.QWKIndex);
|
|||
|
|
WriteLn(ControlTxt,Caps(StripColor(MemMsgArea.FileName)));
|
|||
|
|
END
|
|||
|
|
ELSE IF (MArea = -1) THEN
|
|||
|
|
BEGIN
|
|||
|
|
WriteLn(ControlTxt,0);
|
|||
|
|
WriteLn(ControlTxt,'Private Mail');
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
WriteLn(ControlTxt,'WELCOME');
|
|||
|
|
WriteLn(ControlTxt,'NEWS');
|
|||
|
|
WriteLn(ControlTxt,'GOODBYE');
|
|||
|
|
Close(ControlTxt);
|
|||
|
|
|
|||
|
|
IF (ThisUser.ScanFilesQWK) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Assign(NewFilesF,TempDir+'QWK\NEWFILES.DAT');
|
|||
|
|
ReWrite(NewFilesF);
|
|||
|
|
InitFArray(FArray);
|
|||
|
|
FArrayRecNum := 0;
|
|||
|
|
GlobalNewFileScan(FArrayRecNum);
|
|||
|
|
Close(NewFilesF);
|
|||
|
|
LastError := IOResult;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (General.QWKWelcome <> '') THEN
|
|||
|
|
BEGIN
|
|||
|
|
S := General.QWKWelcome;
|
|||
|
|
IF (OkANSI) AND Exist(S+'.ANS') THEN
|
|||
|
|
S := S +'.ANS'
|
|||
|
|
ELSE
|
|||
|
|
S := S +'.ASC';
|
|||
|
|
CopyMoveFile(TRUE,'',S,TempDir+'QWK\WELCOME',FALSE);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (General.QWKNews <> '') THEN
|
|||
|
|
BEGIN
|
|||
|
|
S := General.QWKNews;
|
|||
|
|
IF (OkANSI) AND Exist(S+'.ANS') THEN
|
|||
|
|
S := S +'.ANS'
|
|||
|
|
ELSE
|
|||
|
|
S := S +'.ASC';
|
|||
|
|
CopyMoveFile(TRUE,'',S,TempDir+'QWK\NEWS',FALSE);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (General.QWKGoodBye <> '') THEN
|
|||
|
|
BEGIN
|
|||
|
|
S := General.QWKGoodBye;
|
|||
|
|
IF (OkANSI) AND Exist(S+'.ANS') THEN
|
|||
|
|
S := S +'.ANS'
|
|||
|
|
ELSE
|
|||
|
|
S := S +'.ASC';
|
|||
|
|
CopyMoveFile(TRUE,'',S,TempDir+'QWK\GOODBYE',FALSE);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
Assign(MsgFile,TempDir+'QWK\MESSAGES.DAT');
|
|||
|
|
|
|||
|
|
S := 'The Renegade Developement Team, Copyright (c) 1992-2009 (All rights reserved)';
|
|||
|
|
WHILE (Length(S) < 128) DO
|
|||
|
|
S := S + ' ';
|
|||
|
|
ReWrite(MsgFile,1);
|
|||
|
|
BlockWrite(MsgFile,S[1],128);
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.Crap,SizeOf(QWKHeader.Crap),0);
|
|||
|
|
|
|||
|
|
Assign(PNDXFile,TempDir+'QWK\PERSONAL.NDX');
|
|||
|
|
ReWrite(PNDXFile);
|
|||
|
|
|
|||
|
|
LastK := 0;
|
|||
|
|
(*
|
|||
|
|
TotalNewMsgsInArea := 0;
|
|||
|
|
*)
|
|||
|
|
TotalMsgsAllAreas := 0;
|
|||
|
|
TotalNewMsgsAllAreas := 0;
|
|||
|
|
TotalYourMsgsAllAreas := 0;
|
|||
|
|
|
|||
|
|
TempPause := FALSE;
|
|||
|
|
Abort := FALSE;
|
|||
|
|
Next := FALSE;
|
|||
|
|
|
|||
|
|
CLS;
|
|||
|
|
Print(Centre('|The QWK<57>System is now gathering mail.'));
|
|||
|
|
NL;
|
|||
|
|
PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
|
|||
|
|
PrintACR('s<>t Num s<>u Message area name s<>v Short s<>w Echo s<>x Total '+
|
|||
|
|
's<>y New s<>z Your s<>{ Size s<>');
|
|||
|
|
PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgPWord,SizeOf(QWKHeader.MsgPWord),' ');
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.RNum,SizeOf(QWKHeader.RNum),' ');
|
|||
|
|
|
|||
|
|
QWKHeader.Status := 225;
|
|||
|
|
|
|||
|
|
FOR MArea := -1 TO NumMsgAreas DO
|
|||
|
|
BEGIN
|
|||
|
|
IF (IOResult <> 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
WriteLn('error processing QWK packet.');
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (MArea = 0) OR ((MArea = -1) AND (NOT ThisUser.PrivateQWK)) OR
|
|||
|
|
((CompMsgArea(MArea,0) = 0) AND (MArea >= 0)) THEN
|
|||
|
|
Continue;
|
|||
|
|
|
|||
|
|
InitMsgArea(MArea);
|
|||
|
|
|
|||
|
|
IF (MArea > 0) THEN
|
|||
|
|
UseMsgArea := MemMsgArea.QWKIndex
|
|||
|
|
ELSE
|
|||
|
|
UseMsgArea := 0;
|
|||
|
|
|
|||
|
|
IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR
|
|||
|
|
(MAForceRead IN MemMsgArea.MAFlags)) AND (NOT Abort) AND (NOT HangUp) THEN
|
|||
|
|
BEGIN
|
|||
|
|
LastError := IOResult;
|
|||
|
|
Reset(MsgHdrF);
|
|||
|
|
IF (IOResult = 2) THEN
|
|||
|
|
ReWrite(MsgHdrF);
|
|||
|
|
Reset(MsgTxtF,1);
|
|||
|
|
IF (IOResult = 2) THEN
|
|||
|
|
ReWrite(MsgTxtF,1);
|
|||
|
|
|
|||
|
|
QWKHeader.MBase := UseMsgArea;
|
|||
|
|
|
|||
|
|
IndexR.Conf := UseMsgArea;
|
|||
|
|
|
|||
|
|
TotalNewMsgsInArea := 0;
|
|||
|
|
|
|||
|
|
TotalYourMsgsInArea := 0;
|
|||
|
|
|
|||
|
|
PrintMain('}'+PadRightInt(MArea,4)+
|
|||
|
|
' ~'+PadLeftStr(MemMsgArea.Name,22)+
|
|||
|
|
' '+PadLeftStr(MemMsgArea.FileName,11)+
|
|||
|
|
'<13>'+PadLeftStr(ShowYesNo(MemMsgArea.MAType <> 0),3)+
|
|||
|
|
'<13>'+PadRightInt(FileSize(MsgHdrF),8));
|
|||
|
|
|
|||
|
|
Upload_Display;
|
|||
|
|
|
|||
|
|
IF (UseMsgArea > 0) THEN
|
|||
|
|
MsgNum := FirstNew
|
|||
|
|
ELSE
|
|||
|
|
MsgNum := 1;
|
|||
|
|
|
|||
|
|
IF (MsgNum > 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
|
|||
|
|
S := IntToStr(UseMsgArea);
|
|||
|
|
|
|||
|
|
WHILE (Length(S) < 3) DO
|
|||
|
|
S := '0' + S;
|
|||
|
|
|
|||
|
|
Assign(NDXFile,TempDir+'QWK\'+S+'.NDX');
|
|||
|
|
ReWrite(NDXFile);
|
|||
|
|
|
|||
|
|
WKey;
|
|||
|
|
|
|||
|
|
WHILE (MsgNum <= FileSize(MsgHdrF)) AND
|
|||
|
|
(TotalNewMsgsInArea < General.MaxQWKBase) AND
|
|||
|
|
((TotalNewMsgsAllAreas + TotalNewMsgsInArea) < General.MaxQWKTotal) AND
|
|||
|
|
(NOT Abort) AND (NOT HangUp) DO
|
|||
|
|
BEGIN
|
|||
|
|
IF (MArea >= 0) THEN
|
|||
|
|
Inc(TotalNewMsgsInArea);
|
|||
|
|
WKey;
|
|||
|
|
IF ((Timer - LastUpdate) > 3) OR ((Timer - LastUpdate) < 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
BackErase(22);
|
|||
|
|
Upload_Display;
|
|||
|
|
END;
|
|||
|
|
Seek(MsgHdrF,(MsgNum - 1));
|
|||
|
|
Read(MsgHdrF,MHeader);
|
|||
|
|
IF (NOT (MDeleted IN MHeader.Status)) AND
|
|||
|
|
NOT (Unvalidated IN MHeader.Status) AND
|
|||
|
|
NOT (FromYou(MHeader) AND NOT ThisUser.GetOwnQWK) AND
|
|||
|
|
NOT ((Prvt IN MHeader.Status) AND NOT (FromYou(MHeader) OR ToYou(MHeader))) AND
|
|||
|
|
NOT ((MArea = -1) AND NOT (ToYou(MHeader))) THEN
|
|||
|
|
BEGIN
|
|||
|
|
|
|||
|
|
IF (MArea = -1) THEN
|
|||
|
|
Inc(TotalNewMsgsInArea);
|
|||
|
|
|
|||
|
|
IF (Prvt IN MHeader.Status) THEN
|
|||
|
|
QWKHeader.Flag := '*'
|
|||
|
|
ELSE
|
|||
|
|
QWKHeader.Flag := ' ';
|
|||
|
|
|
|||
|
|
S := IntToStr(MsgNum);
|
|||
|
|
FillChar(QWKHeader.Num[1],SizeOf(QWKHeader.Num),' ');
|
|||
|
|
Move(S[1],QWKHeader.Num[1],Length(S));
|
|||
|
|
|
|||
|
|
PackToDate(DT,MHeader.Date);
|
|||
|
|
|
|||
|
|
IF (MHeader.From.Anon = 0) THEN
|
|||
|
|
S := ZeroPad(IntToStr(DT.Month))+
|
|||
|
|
'-'+ZeroPad(IntToStr(DT.Day))+
|
|||
|
|
'-'+Copy(IntToStr(DT.Year),3,2)
|
|||
|
|
ELSE
|
|||
|
|
S := '';
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgDate[1],SizeOf(QWKHeader.MsgDate),' ');
|
|||
|
|
Move(S[1],QWKHeader.MsgDate[1],Length(S));
|
|||
|
|
|
|||
|
|
IF (MHeader.From.Anon = 0) THEN
|
|||
|
|
S := ZeroPad(IntToStr(DT.Hour))+
|
|||
|
|
':'+ZeroPad(IntToStr(DT.Min))
|
|||
|
|
ELSE
|
|||
|
|
S := '';
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgTime,SizeOf(QWKHeader.MsgTime),' ');
|
|||
|
|
Move(S[1],QWKHeader.MsgTime[1],Length(S));
|
|||
|
|
|
|||
|
|
S := MHeader.MTo.A1S;
|
|||
|
|
IF (MARealName IN MemMsgArea.MAFlags) THEN
|
|||
|
|
S := AllCaps(MHeader.MTo.Real);
|
|||
|
|
S := Caps(Usename(MHeader.MTo.Anon,S));
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgTo,SizeOf(QWKHeader.MsgTo),' ');
|
|||
|
|
Move(S[1],QWKHeader.MsgTo[1],Length(S));
|
|||
|
|
|
|||
|
|
S := MHeader.From.A1S;
|
|||
|
|
IF (MARealName IN MemMsgArea.MAFlags) THEN
|
|||
|
|
S := AllCaps(MHeader.From.Real);
|
|||
|
|
S := Caps(Usename(MHeader.From.Anon,S));
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgFrom[1],SizeOf(QWKHeader.MsgFrom),' ');
|
|||
|
|
Move(S[1],QWKHeader.MsgFrom[1],Length(S));
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.MsgSubj[1],SizeOf(QWKHeader.MsgSubj),' ');
|
|||
|
|
|
|||
|
|
IF (MHeader.FileAttached > 0) THEN
|
|||
|
|
MHeader.Subject := StripName(MHeader.Subject);
|
|||
|
|
|
|||
|
|
Move(MHeader.Subject[1],QWKHeader.MsgSubj[1],Length(MHeader.Subject));
|
|||
|
|
|
|||
|
|
Marker := FilePos(MsgFile);
|
|||
|
|
|
|||
|
|
BlockWrite(MsgFile,QWKHeader,128);
|
|||
|
|
|
|||
|
|
Real_To_Msb(FileSize(MsgFile) DIV 128,IndexR.Pointer);
|
|||
|
|
Write(NDXFile,IndexR);
|
|||
|
|
|
|||
|
|
IF ToYou(MHeader) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Write(PNDXFile,IndexR);
|
|||
|
|
Inc(TotalYourMsgsInArea);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
X := 1;
|
|||
|
|
TempTextSize := 0;
|
|||
|
|
Texts := '';
|
|||
|
|
|
|||
|
|
IF ((MHeader.Pointer - 1) < FileSize(MsgTxtF)) AND
|
|||
|
|
(((MHeader.Pointer - 1) + MHeader.TextSize) <= FileSize(MsgTxtF)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Seek(MsgTxtF,(MHeader.Pointer - 1));
|
|||
|
|
REPEAT
|
|||
|
|
BlockRead(MsgTxtF,S[0],1);
|
|||
|
|
BlockRead(MsgTxtF,S[1],Byte(S[0]));
|
|||
|
|
Inc(TempTextSize,(Length(S) + 1));
|
|||
|
|
S := S + '<27>';
|
|||
|
|
Texts := Texts + S;
|
|||
|
|
IF (Length(Texts) > 128) THEN
|
|||
|
|
BEGIN
|
|||
|
|
BlockWrite(MsgFile,Texts[1],128);
|
|||
|
|
Inc(X);
|
|||
|
|
Move(Texts[129],Texts[1],(Length(Texts) - 128));
|
|||
|
|
Dec(Texts[0],128);
|
|||
|
|
END;
|
|||
|
|
UNTIL (TempTextSize >= MHeader.TextSize);
|
|||
|
|
IF (Texts <> '') THEN
|
|||
|
|
BEGIN
|
|||
|
|
IF (Length(Texts) < 128) THEN
|
|||
|
|
BEGIN
|
|||
|
|
FillChar(Texts[Length(Texts) + 1],(128 - Length(Texts)),32);
|
|||
|
|
Texts[0] := #128;
|
|||
|
|
END;
|
|||
|
|
BlockWrite(MsgFile,Texts[1],128);
|
|||
|
|
Inc(X);
|
|||
|
|
END;
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
Include(MHeader.Status,MDeleted);
|
|||
|
|
MHeader.TextSize := 0;
|
|||
|
|
MHeader.Pointer := -1;
|
|||
|
|
Seek(MsgHdrF,(MsgNum - 1));
|
|||
|
|
Write(MsgHdrF,MHeader);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
S := IntToStr(X);
|
|||
|
|
|
|||
|
|
FillChar(QWKHeader.NumBlocks[1],SizeOf(QWKHeader.NumBlocks),' ');
|
|||
|
|
Move(S[1],QWKHeader.NumBlocks[1],Length(S));
|
|||
|
|
|
|||
|
|
Seek(MsgFile,Marker);
|
|||
|
|
BlockWrite(MsgFile,QWKHeader,128);
|
|||
|
|
Seek(MsgFile,FileSize(MsgFile));
|
|||
|
|
END;
|
|||
|
|
Inc(MsgNum);
|
|||
|
|
END;
|
|||
|
|
Close(NDXFile);
|
|||
|
|
END;
|
|||
|
|
BackErase(22);
|
|||
|
|
Upload_Display;
|
|||
|
|
NL;
|
|||
|
|
IF (TotalNewMsgsInArea >= General.MaxQWKBase) THEN
|
|||
|
|
Print('Maximum number of messages per area reached.');
|
|||
|
|
IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) THEN
|
|||
|
|
Print('Maximum number of messages per QWK packet reached.');
|
|||
|
|
LastK := FileSize(MsgFile);
|
|||
|
|
Inc(TotalNewMsgsAllAreas,TotalNewMsgsInArea);
|
|||
|
|
Inc(TotalYourMsgsAllAreas,TotalYourMsgsInArea);
|
|||
|
|
Inc(TotalMsgsAllAreas,FileSize(MsgHdrF));
|
|||
|
|
Close(MsgHdrF);
|
|||
|
|
Close(MsgTxtF);
|
|||
|
|
END;
|
|||
|
|
IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) OR Abort THEN
|
|||
|
|
Break;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (FileSize(PNDXFile) = 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Close(PNDXFile);
|
|||
|
|
Erase(PNDXFile);
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
Close(PNDXFile);
|
|||
|
|
NL;
|
|||
|
|
|
|||
|
|
IF (NOT Abort) THEN
|
|||
|
|
Print('^0 Totals:'+PadRightInt(TotalMsgsAllAreas,43)+PadRightInt(TotalNewMsgsAllAreas,7)+
|
|||
|
|
PadRightInt(TotalYourMsgsAllAreas,6)+
|
|||
|
|
PadRightStr(IntToStr(FileSize(MsgFile) DIV 1024)+'k',8));
|
|||
|
|
|
|||
|
|
Close(MsgFile);
|
|||
|
|
NL;
|
|||
|
|
|
|||
|
|
lil := 0;
|
|||
|
|
IF (TotalNewMsgsAllAreas < 1) OR (Abort) THEN
|
|||
|
|
BEGIN
|
|||
|
|
IF (TotalNewMsgsAllAreas < 1) THEN
|
|||
|
|
Print('No new messages!');
|
|||
|
|
OffLineMail := FALSE;
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (MakeQWKFor = 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
IF NOT PYNQ('Proceed to packet compression: ',0,TRUE) THEN
|
|||
|
|
BEGIN
|
|||
|
|
OffLineMail := FALSE;
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
NL;
|
|||
|
|
Star('Compressing '+General.PacketName+'.QWK');
|
|||
|
|
|
|||
|
|
ArcComp(Ok,ThisUser.DefArcType,TempDir+'QWK\'+General.PacketName+'.QWK',TempDir+'QWK\*.*');
|
|||
|
|
IF (NOT Ok) OR (NOT Exist(TempDir+'QWK\'+General.PacketName+'.QWK')) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('Error archiving QWK packet!');
|
|||
|
|
OffLineMail := FALSE;
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
SysOpLog('QWK packet created.');
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
FindFirst(TempDir+'QWK\'+General.PacketName+'.QWK',AnyFile,DirInfo);
|
|||
|
|
IF (InCom) AND (NSL < (DirInfo.Size DIV Rate)) AND (NOT General.qwktimeignore) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('Sorry, not enough time left online to transfer.');
|
|||
|
|
OffLineMail := FALSE;
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
Star('Compressed packet size is '+ConvertBytes(DirInfo.Size,FALSE)+'.');
|
|||
|
|
|
|||
|
|
IF (InCom) AND (NOT HangUp) THEN
|
|||
|
|
BEGIN
|
|||
|
|
SaveFileArea := FileArea;
|
|||
|
|
FileArea := -1;
|
|||
|
|
WITH MemFileArea DO
|
|||
|
|
BEGIN
|
|||
|
|
AreaName := 'Offline Mail';
|
|||
|
|
DLPath := TempDir+'QWK\';
|
|||
|
|
ULPath := TempDir+'QWK\';
|
|||
|
|
FAFlags := [FANoRatio];
|
|||
|
|
END;
|
|||
|
|
WITH FileInfo DO
|
|||
|
|
BEGIN
|
|||
|
|
FileName := Align(General.PacketName+'.QWK');
|
|||
|
|
Description := 'QWK Download';
|
|||
|
|
FilePoints := 0;
|
|||
|
|
Downloaded := 0;
|
|||
|
|
FileSize := GetFileSize(TempDir+'QWK\'+General.PacketName+'.QWK');
|
|||
|
|
OwnerNum := UserNum;
|
|||
|
|
OwnerName := Caps(ThisUser.Name);
|
|||
|
|
FileDate := Date2PD(DateStr);
|
|||
|
|
VPointer := -1;
|
|||
|
|
VTextSize := 0;
|
|||
|
|
FIFlags := [];
|
|||
|
|
END;
|
|||
|
|
TransferFlags := [IsQWK];
|
|||
|
|
DLX(FileInfo,-1,TransferFlags);
|
|||
|
|
FileArea := SaveFileArea;
|
|||
|
|
LoadFileArea(FileArea);
|
|||
|
|
IF (IsTransferOk IN TransferFlags) AND (NOT (IsKeyboardAbort IN TransferFlags)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
|
|||
|
|
Star('Updating message pointers');
|
|||
|
|
|
|||
|
|
Inc(PublicReadThisCall,TotalNewMsgsAllAreas);
|
|||
|
|
|
|||
|
|
UpdatePointers;
|
|||
|
|
|
|||
|
|
Star('Message pointers updated');
|
|||
|
|
|
|||
|
|
IF (ThisUser.PrivateQWK) THEN
|
|||
|
|
BEGIN
|
|||
|
|
KillEmail;
|
|||
|
|
Star('Private messages killed.');
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
END;
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
S := General.QWKLocalPath+General.PacketName;
|
|||
|
|
IF Exist(S+'.QWK') AND ((MakeQWKFor > 0) OR NOT (PYNQ(^M^J'Replace existing .QWK? ',0,FALSE))) THEN
|
|||
|
|
FOR C := 'A' TO 'Z' DO
|
|||
|
|
IF NOT (Exist(S+'.QW'+C)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
S := S + '.QW' + C;
|
|||
|
|
Break;
|
|||
|
|
END;
|
|||
|
|
IF (Pos('.', S) = 0) THEN
|
|||
|
|
S := S + '.QWK';
|
|||
|
|
|
|||
|
|
CopyMoveFile(TRUE,'',TempDir+'QWK\'+General.PacketName+'.QWK',S,FALSE);
|
|||
|
|
|
|||
|
|
NL;
|
|||
|
|
UpdatePointers;
|
|||
|
|
IF (ThisUser.PrivateQWK) THEN
|
|||
|
|
KillEmail;
|
|||
|
|
END;
|
|||
|
|
IF Exist(TempDir+'QWK\'+General.PacketName+'.REP') THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Star('Bidirectional upload of '+General.PacketName+'.REP detected');
|
|||
|
|
UploadPacket(TRUE);
|
|||
|
|
END;
|
|||
|
|
OffLineMail := FALSE;
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
LoadMsgArea(MsgArea);
|
|||
|
|
LastError := IOResult;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
|
|||
|
|
PROCEDURE uploadpacket(Already:Boolean);
|
|||
|
|
VAR
|
|||
|
|
F: FILE;
|
|||
|
|
User: UserRecordType;
|
|||
|
|
MHeader: MHeaderRec;
|
|||
|
|
QWKHeader: QWKHeadeRec;
|
|||
|
|
|
|||
|
|
S,
|
|||
|
|
Os: STRING;
|
|||
|
|
|
|||
|
|
Counter,
|
|||
|
|
Counter1: Byte;
|
|||
|
|
|
|||
|
|
RCode,
|
|||
|
|
MArea,
|
|||
|
|
SaveMsgArea: Integer;
|
|||
|
|
|
|||
|
|
X,
|
|||
|
|
Blocks: Word;
|
|||
|
|
|
|||
|
|
TransferTime,
|
|||
|
|
TempDate: LongInt;
|
|||
|
|
|
|||
|
|
Ok,
|
|||
|
|
UploadOk,
|
|||
|
|
KeyboardAbort,
|
|||
|
|
AddBatch,
|
|||
|
|
SaveConfSystem: Boolean;
|
|||
|
|
|
|||
|
|
FUNCTION FindBase(IndexNumber: Word): Word;
|
|||
|
|
VAR
|
|||
|
|
j,
|
|||
|
|
k: Integer;
|
|||
|
|
BEGIN
|
|||
|
|
Reset(MsgAreaFile);
|
|||
|
|
j := 0;
|
|||
|
|
k := 0;
|
|||
|
|
WHILE (j = 0) AND NOT (EOF(MsgAreaFile)) DO
|
|||
|
|
BEGIN
|
|||
|
|
Inc(k);
|
|||
|
|
Read(MsgAreaFile,MemMsgArea);
|
|||
|
|
IF (MemMsgArea.QWKIndex = IndexNumber) THEN
|
|||
|
|
j := k;
|
|||
|
|
END;
|
|||
|
|
Close(MsgAreaFile);
|
|||
|
|
FindBase := k;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
BEGIN
|
|||
|
|
IF (RPost IN ThisUser.Flags) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('You are restricted from posting messages.');
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
SaveMsgArea := MsgArea; (* Was ReadMsgArea *)
|
|||
|
|
|
|||
|
|
SaveConfSystem := ConfSystem;
|
|||
|
|
ConfSystem := FALSE;
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
NewCompTables;
|
|||
|
|
|
|||
|
|
PurgeDir(TempDir+'UP\',FALSE);
|
|||
|
|
|
|||
|
|
TimeLock := TRUE;
|
|||
|
|
|
|||
|
|
UploadOk := TRUE;
|
|||
|
|
KeyboardAbort := FALSE;
|
|||
|
|
|
|||
|
|
IF (ComPortSpeed = 0) OR (UpQWKFor > 0) THEN
|
|||
|
|
CopyMoveFile(TRUE,'',General.QWKLocalPath+General.PacketName+'.REP',TempDir + 'QWK\' + General.PacketName+'.REP',FALSE)
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
IF (NOT Already) THEN
|
|||
|
|
Receive(General.PacketName+'.REP',TempDir+'\QWK',FALSE,UploadOk,KeyboardAbort,AddBatch,TransferTime)
|
|||
|
|
ELSE
|
|||
|
|
CopyMoveFile(FALSE,'',TempDir+'UP\'+General.PacketName+'.REP',
|
|||
|
|
TempDir+'QWK\'+General.PacketName+'.REP',FALSE);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
TimeLock := FALSE;
|
|||
|
|
|
|||
|
|
IF (UploadOk) AND (NOT KeyboardAbort) THEN
|
|||
|
|
BEGIN
|
|||
|
|
|
|||
|
|
SysOpLog('Uploaded REP packet');
|
|||
|
|
|
|||
|
|
IF (NOT Already) THEN
|
|||
|
|
Print('Transfer successful');
|
|||
|
|
|
|||
|
|
ExecBatch(Ok,TempDir+'QWK\',General.ArcsPath+
|
|||
|
|
FunctionalMCI(General.FileArcInfo[ThisUser.DefArcType].UnArcLine,
|
|||
|
|
TempDir+'QWK\'+General.PacketName+'.REP',
|
|||
|
|
General.PacketName+'.MSG'),
|
|||
|
|
General.FileArcInfo[ThisUser.DefArcType].SuccLevel,RCode,FALSE);
|
|||
|
|
|
|||
|
|
IF (Ok) AND Exist(TempDir+'QWK\'+General.PacketName+'.MSG') THEN
|
|||
|
|
BEGIN
|
|||
|
|
Assign(F,TempDir+'QWK\'+General.PacketName+'.MSG');
|
|||
|
|
Reset(F,1);
|
|||
|
|
|
|||
|
|
GetFTime(F,TempDate);
|
|||
|
|
|
|||
|
|
IF (TempDate = ThisUser.LastQWK) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NL;
|
|||
|
|
Print('This packet has already been uploaded here.');
|
|||
|
|
Close(F);
|
|||
|
|
Exit;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
ThisUser.LastQWK := TempDate;
|
|||
|
|
|
|||
|
|
MHeader.FileAttached := 0;
|
|||
|
|
MHeader.MTo.UserNum := 0;
|
|||
|
|
MHeader.MTo.Anon := 0;
|
|||
|
|
MHeader.ReplyTo := 0;
|
|||
|
|
MHeader.Replies := 0;
|
|||
|
|
|
|||
|
|
TempDate := GetPackDateTime;
|
|||
|
|
|
|||
|
|
BlockRead(F,S,128);
|
|||
|
|
WHILE NOT EOF(F) DO
|
|||
|
|
BEGIN
|
|||
|
|
IF (IOResult <> 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
WriteLn('error processing REP packet.');
|
|||
|
|
Break;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
BlockRead(F,QWKHeader,128);
|
|||
|
|
|
|||
|
|
S[0] := #6;
|
|||
|
|
Move(QWKHeader.NumBlocks[1],S[1],6);
|
|||
|
|
|
|||
|
|
Blocks := (StrToInt(S) - 1);
|
|||
|
|
|
|||
|
|
IF (QWKHeader.MBase = 0) THEN
|
|||
|
|
MArea := -1
|
|||
|
|
ELSE
|
|||
|
|
MArea := FindBase(QWKHeader.MBase);
|
|||
|
|
|
|||
|
|
InitMsgArea(MArea);
|
|||
|
|
|
|||
|
|
IF AACS(MemMsgArea.ACS) AND AACS(MemMsgArea.PostACS) AND NOT
|
|||
|
|
((PublicPostsToday >= General.MaxPubPost) AND (NOT MsgSysOp)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
LastError := IOResult;
|
|||
|
|
Reset(MsgHdrF);
|
|||
|
|
IF (IOResult = 2) THEN
|
|||
|
|
ReWrite(MsgHdrF);
|
|||
|
|
Reset(MsgTxtF,1);
|
|||
|
|
IF (IOResult = 2) THEN
|
|||
|
|
ReWrite(MsgTxtF,1);
|
|||
|
|
|
|||
|
|
IF AACS(General.QWKNetworkACS) THEN
|
|||
|
|
BEGIN
|
|||
|
|
S[0] := #25;
|
|||
|
|
Move(QWKHeader.MsgFrom[1],S[1],SizeOf(QWKHeader.MsgFrom));
|
|||
|
|
WHILE (S[Length(S)] = ' ') DO
|
|||
|
|
Dec(S[0]);
|
|||
|
|
MHeader.From.UserNum := 0;
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
IF (MARealName IN MemMsgArea.MAFlags) THEN
|
|||
|
|
S := ThisUser.RealName
|
|||
|
|
ELSE
|
|||
|
|
S := ThisUser.Name;
|
|||
|
|
MHeader.From.UserNum := UserNum;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
MHeader.From.A1S := S;
|
|||
|
|
MHeader.From.Real := S;
|
|||
|
|
MHeader.From.Name := S;
|
|||
|
|
MHeader.From.Anon := 0;
|
|||
|
|
|
|||
|
|
S[0] := #25;
|
|||
|
|
Move(QWKHeader.MsgTo[1],S[1],SizeOf(QWKHeader.MsgTo));
|
|||
|
|
|
|||
|
|
WHILE (S[Length(S)] = ' ') DO
|
|||
|
|
Dec(S[0]);
|
|||
|
|
|
|||
|
|
MHeader.MTo.A1S := S;
|
|||
|
|
MHeader.MTo.Real := S;
|
|||
|
|
MHeader.MTo.Name := S;
|
|||
|
|
MHeader.MTo.UserNum := SearchUser(MHeader.MTo.Name,FALSE);
|
|||
|
|
|
|||
|
|
MHeader.Pointer := (FileSize(MsgTxtF) + 1);
|
|||
|
|
MHeader.Date := TempDate;
|
|||
|
|
Inc(TempDate);
|
|||
|
|
GetDayOfWeek(MHeader.DayOfWeek);
|
|||
|
|
|
|||
|
|
MHeader.Status := [];
|
|||
|
|
|
|||
|
|
IF (QWKHeader.Flag IN ['*','+']) AND (MAPrivate IN MemMsgArea.MAFlags) THEN
|
|||
|
|
Include(MHeader.Status,Prvt);
|
|||
|
|
|
|||
|
|
IF (RValidate IN ThisUser.Flags) THEN
|
|||
|
|
Include(MHeader.Status,Unvalidated);
|
|||
|
|
|
|||
|
|
IF (AACS(MemMsgArea.MCIACS)) THEN
|
|||
|
|
Include(MHeader.Status,AllowMCI);
|
|||
|
|
|
|||
|
|
Move(QWKHeader.MsgSubj[1],S[1],SizeOf(QWKHeader.MsgSubj));
|
|||
|
|
S[0] := Chr(SizeOf(QWKHeader.MsgSubj));
|
|||
|
|
|
|||
|
|
WHILE (S[Length(S)] = ' ') DO
|
|||
|
|
Dec(S[0]);
|
|||
|
|
|
|||
|
|
MHeader.Subject := S;
|
|||
|
|
|
|||
|
|
SysOpLog(MHeader.From.Name+' posted on '+MemMsgArea.Name);
|
|||
|
|
SysOpLog('To: '+MHeader.MTo.Name);
|
|||
|
|
|
|||
|
|
MHeader.OriginDate[0] := #14;
|
|||
|
|
Move(QWKHeader.MsgDate[1],MHeader.OriginDate[1],8);
|
|||
|
|
MHeader.OriginDate[9] := #32;
|
|||
|
|
Move(QWKHeader.MsgTime[1],MHeader.OriginDate[10],5);
|
|||
|
|
|
|||
|
|
MHeader.TextSize := 0;
|
|||
|
|
|
|||
|
|
IF (AllCaps(MHeader.MTo.A1S) <> 'QMAIL') THEN
|
|||
|
|
BEGIN
|
|||
|
|
Seek(MsgTxtF,FileSize(MsgTxtF));
|
|||
|
|
Os := '';
|
|||
|
|
X := 1;
|
|||
|
|
WHILE (X <= Blocks) AND (IOResult = 0) DO
|
|||
|
|
BEGIN
|
|||
|
|
BlockRead(F,S[1],128);
|
|||
|
|
S[0] := #128;
|
|||
|
|
S := Os + S;
|
|||
|
|
WHILE (Pos('<27>',S) > 0) DO
|
|||
|
|
BEGIN
|
|||
|
|
Os := Copy(S,1,Pos('<27>',S)-1);
|
|||
|
|
S := Copy(S,Pos('<27>',S)+1,Length(S));
|
|||
|
|
IF (MemMsgArea.MAType <> 0) AND (Copy(Os,1,4) = '--- ') THEN
|
|||
|
|
Os := ''
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
IF (LennMCI(Os) > 78) THEN
|
|||
|
|
Os := Copy(Os,1,78 + Length(Os) - LennMCI(Os));
|
|||
|
|
Inc(MHeader.TextSize,Length(Os)+1);
|
|||
|
|
BlockWrite(MsgTxtF,Os,Length(Os)+1);
|
|||
|
|
END;
|
|||
|
|
END;
|
|||
|
|
Os := S;
|
|||
|
|
Inc(X);
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
WHILE (S[Length(S)] = ' ') DO
|
|||
|
|
Dec(S[0]);
|
|||
|
|
|
|||
|
|
IF (Length(S) > 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Inc(MHeader.TextSize,(Length(S) + 1));
|
|||
|
|
BlockWrite(MsgTxtF,S,(Length(S) + 1));
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (MemMsgArea.MAType <> 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
NewEchoMail := TRUE;
|
|||
|
|
IF NOT (MAScanOut IN MemMsgArea.MAFlags) THEN
|
|||
|
|
UpdateBoard;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
IF (MemMsgArea.MAType <> 0) AND (MAAddTear IN MemMsgArea.MAFlags) THEN
|
|||
|
|
WITH MemMsgArea DO
|
|||
|
|
BEGIN
|
|||
|
|
S := '--- Renegade v'+General.Version;
|
|||
|
|
Inc(MHeader.TextSize,(Length(S) + 1));
|
|||
|
|
BlockWrite(MsgTxtF,S,(Length(S) + 1));
|
|||
|
|
IF (MemMsgArea.Origin <> '') THEN
|
|||
|
|
S := MemMsgArea.Origin
|
|||
|
|
ELSE
|
|||
|
|
S := General.Origin;
|
|||
|
|
S := ' * Origin: '+S+' (';
|
|||
|
|
IF (AKA > 19) THEN
|
|||
|
|
AKA := 0;
|
|||
|
|
S := S + IntToStr(General.AKA[AKA].Zone)+':'+
|
|||
|
|
IntToStr(General.AKA[AKA].Net)+'/'+
|
|||
|
|
IntToStr(General.AKA[AKA].Node);
|
|||
|
|
IF (General.AKA[AKA].Point > 0) THEN
|
|||
|
|
S := S +'.'+IntToStr(General.AKA[AKA].Point);
|
|||
|
|
S := S + ')';
|
|||
|
|
Inc(MHeader.TextSize,(Length(S) + 1));
|
|||
|
|
BlockWrite(MsgTxtF,S,(Length(S) + 1));
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
CLS;
|
|||
|
|
Ok := FALSE;
|
|||
|
|
UploadOk := FALSE;
|
|||
|
|
Seek(MsgHdrF,FileSize(MsgHdrF));
|
|||
|
|
Write(MsgHdrF,MHeader);
|
|||
|
|
|
|||
|
|
IF (UpQWKFor <= 0) THEN
|
|||
|
|
Anonymous(TRUE,MHeader);
|
|||
|
|
|
|||
|
|
IF (MArea = -1) THEN
|
|||
|
|
BEGIN
|
|||
|
|
IF (MHeader.MTo.UserNum = 0) THEN
|
|||
|
|
BEGIN
|
|||
|
|
IF (AACS(General.NetMailACS)) AND
|
|||
|
|
(PYNQ(^M^J'Is this to be a netmail message? ',0,FALSE)) THEN
|
|||
|
|
BEGIN
|
|||
|
|
IF (General.AllowAlias) AND PYNQ('Send this with your real name? ',0,FALSE) THEN
|
|||
|
|
MHeader.From.A1S := ThisUser.RealName;
|
|||
|
|
WITH MHeader.MTo DO
|
|||
|
|
GetNetAddress(Name,Zone,Net,Node,Point,X,FALSE);
|
|||
|
|
IF (MHeader.MTo.Name = '') THEN
|
|||
|
|
Include(MHeader.Status,MDeleted)
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
Inc(ThisUser.Debit,X);
|
|||
|
|
Include(MHeader.Status,NetMail);
|
|||
|
|
MHeader.NetAttribute := General.NetAttribute *
|
|||
|
|
[Intransit,Private,Crash,KillSent,Hold,Local];
|
|||
|
|
ChangeFlags(MHeader);
|
|||
|
|
Counter1 := 0;
|
|||
|
|
Counter := 0;
|
|||
|
|
WHILE (Counter <= 19) AND (Counter1 = 0) DO
|
|||
|
|
BEGIN
|
|||
|
|
IF (General.AKA[Counter].Zone = MHeader.MTo.Zone) AND
|
|||
|
|
(General.AKA[Counter].Zone <> 0) THEN
|
|||
|
|
Counter1 := Counter;
|
|||
|
|
Inc(Counter);
|
|||
|
|
END;
|
|||
|
|
MHeader.From.Zone := General.AKA[Counter1].Zone;
|
|||
|
|
MHeader.From.Net := General.AKA[Counter1].Net;
|
|||
|
|
MHeader.From.Node := General.AKA[Counter1].Node;
|
|||
|
|
MHeader.From.Point := General.AKA[Counter1].Point;
|
|||
|
|
END;
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
Include(MHeader.Status,MDeleted);
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
IF (MHeader.MTo.UserNum > 1) THEN
|
|||
|
|
BEGIN
|
|||
|
|
Inc(ThisUser.EmailSent);
|
|||
|
|
|
|||
|
|
IF (PrivatePostsToday < 255) THEN
|
|||
|
|
Inc(PrivatePostsToday);
|
|||
|
|
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
Inc(ThisUser.Feedback);
|
|||
|
|
|
|||
|
|
IF (FeedbackPostsToday < 255) THEN
|
|||
|
|
Inc(FeedbackPostsToday);
|
|||
|
|
|
|||
|
|
END;
|
|||
|
|
LoadURec(User,MHeader.MTo.UserNum);
|
|||
|
|
Inc(User.Waiting);
|
|||
|
|
SaveURec(User,MHeader.MTo.UserNum);
|
|||
|
|
END;
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
Inc(ThisUser.MsgPost);
|
|||
|
|
|
|||
|
|
IF (PublicPostsToday < 255) THEN
|
|||
|
|
Inc(PublicPostsToday);
|
|||
|
|
|
|||
|
|
AdjustBalance(General.CreditPost);
|
|||
|
|
END;
|
|||
|
|
Seek(MsgHdrF,(FileSize(MsgHdrF) - 1));
|
|||
|
|
Write(MsgHdrF,MHeader);
|
|||
|
|
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
BEGIN
|
|||
|
|
IF (MHeader.Subject = 'DROP') THEN
|
|||
|
|
BEGIN
|
|||
|
|
LoadLastReadRecord(LastReadRecord);
|
|||
|
|
LastReadRecord.NewScan := FALSE;
|
|||
|
|
SaveLastReadRecord(LastReadRecord)
|
|||
|
|
END
|
|||
|
|
ELSE IF (MHeader.Subject = 'ADD') THEN
|
|||
|
|
BEGIN
|
|||
|
|
LoadLastReadRecord(LastReadRecord);
|
|||
|
|
LastReadRecord.NewScan := TRUE;
|
|||
|
|
SaveLastReadRecord(LastReadRecord);
|
|||
|
|
END;
|
|||
|
|
Seek(F,FilePos(F) + (Blocks * 128));
|
|||
|
|
END;
|
|||
|
|
Close(MsgHdrF);
|
|||
|
|
Close(MsgTxtF);
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
Seek(F,FilePos(F) + (Blocks * 128));
|
|||
|
|
END;
|
|||
|
|
Close(F);
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
Print('Unable to decompress REP packet.');
|
|||
|
|
END
|
|||
|
|
ELSE
|
|||
|
|
Print('Transfer unsuccessful');
|
|||
|
|
|
|||
|
|
IF Exist(General.QWKLocalPath+General.PacketName+'.REP') AND (ComPortSpeed = 0)
|
|||
|
|
AND (UpQWKFor = 0) AND PYNQ(^M^J'Delete REP packet? ',0,FALSE) THEN
|
|||
|
|
Kill(General.QWKLocalPath+General.PacketName+'.REP');
|
|||
|
|
|
|||
|
|
PurgeDir(TempDir+'QWK\',FALSE);
|
|||
|
|
|
|||
|
|
Update_Screen;
|
|||
|
|
|
|||
|
|
IF (SaveConfSystem) THEN
|
|||
|
|
BEGIN
|
|||
|
|
ConfSystem := SaveConfSystem;
|
|||
|
|
NewCompTables;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
MsgArea := SaveMsgArea;
|
|||
|
|
InitMsgArea(MsgArea);
|
|||
|
|
|
|||
|
|
LastError := IOResult;
|
|||
|
|
END;
|
|||
|
|
|
|||
|
|
END.
|