QWK and REP by FTP complete
This commit is contained in:
parent
641bac34ef
commit
9ee5efdf96
|
@ -25,13 +25,16 @@ Const
|
||||||
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
||||||
Function PutBaseConfiguration (Var TempCfg: RecConfig) : Boolean;
|
Function PutBaseConfiguration (Var TempCfg: RecConfig) : Boolean;
|
||||||
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
|
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
|
||||||
|
Function Addr2Str (Addr : RecEchoMailAddr) : String;
|
||||||
|
|
||||||
// MESSAGE BASE
|
// MESSAGE BASE
|
||||||
|
|
||||||
Function MBaseOpenCreate (Var Msg: PMsgBaseABS; Var Area: RecMessageBase; TP: String) : Boolean;
|
Function MBaseOpenCreate (Var Msg: PMsgBaseABS; Var Area: RecMessageBase; TP: String) : Boolean;
|
||||||
|
Function GetOriginLine (Var mArea: RecMessageBase) : String;
|
||||||
Function GetMBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
|
Function GetMBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
|
||||||
Procedure GetMessageScan (UN: Cardinal; TempBase: RecMessageBase; Var TempScan: MScanRec);
|
Procedure GetMessageScan (UN: Cardinal; TempBase: RecMessageBase; Var TempScan: MScanRec);
|
||||||
Procedure PutMessageScan (UN: Cardinal; TempBase: RecMessageBase; TempScan: MScanRec);
|
Procedure PutMessageScan (UN: Cardinal; TempBase: RecMessageBase; TempScan: MScanRec);
|
||||||
|
Procedure MBaseAssignData (Var User: RecUser; Var Msg: PMsgBaseABS; Var TempBase: RecMessageBase);
|
||||||
|
|
||||||
// FILE BASE
|
// FILE BASE
|
||||||
|
|
||||||
|
@ -47,8 +50,87 @@ Implementation
|
||||||
Uses
|
Uses
|
||||||
DOS,
|
DOS,
|
||||||
m_FileIO,
|
m_FileIO,
|
||||||
|
m_DateTime,
|
||||||
m_Strings;
|
m_Strings;
|
||||||
|
|
||||||
|
Function Addr2Str (Addr : RecEchoMailAddr) : String;
|
||||||
|
Var
|
||||||
|
Temp : String[20];
|
||||||
|
Begin
|
||||||
|
Temp := strI2S(Addr.Zone) + ':' + strI2S(Addr.Net) + '/' +
|
||||||
|
strI2S(Addr.Node);
|
||||||
|
|
||||||
|
If Addr.Point <> 0 Then Temp := Temp + '.' + strI2S(Addr.Point);
|
||||||
|
|
||||||
|
Result := Temp;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Function GetOriginLine (Var mArea: RecMessageBase) : String;
|
||||||
|
Var
|
||||||
|
Loc : Byte;
|
||||||
|
FN : String;
|
||||||
|
TF : Text;
|
||||||
|
Buf : Array[1..2048] of Char;
|
||||||
|
Str : String;
|
||||||
|
Count : LongInt;
|
||||||
|
Pick : LongInt;
|
||||||
|
Begin
|
||||||
|
Result := '';
|
||||||
|
Loc := Pos('@RANDOM=', strUpper(mArea.Origin));
|
||||||
|
|
||||||
|
If Loc > 0 Then Begin
|
||||||
|
FN := strStripB(Copy(mArea.Origin, Loc + 8, 255), ' ');
|
||||||
|
|
||||||
|
If Pos(PathChar, FN) = 0 Then FN := bbsCfg.DataPath + FN;
|
||||||
|
|
||||||
|
FileMode := 66;
|
||||||
|
|
||||||
|
Assign (TF, FN);
|
||||||
|
SetTextBuf (TF, Buf, SizeOf(Buf));
|
||||||
|
|
||||||
|
{$I-} Reset (TF); {$I+}
|
||||||
|
|
||||||
|
If IoResult <> 0 Then Exit;
|
||||||
|
|
||||||
|
Count := 0;
|
||||||
|
|
||||||
|
While Not Eof(TF) Do Begin
|
||||||
|
ReadLn (TF, Str);
|
||||||
|
|
||||||
|
If strStripB(Str, ' ') = '' Then Continue;
|
||||||
|
|
||||||
|
Inc (Count);
|
||||||
|
End;
|
||||||
|
|
||||||
|
If Count = 0 Then Begin
|
||||||
|
Close (TF);
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Pick := Random(Count) + 1;
|
||||||
|
|
||||||
|
Reset (TF);
|
||||||
|
|
||||||
|
Count := 0;
|
||||||
|
|
||||||
|
While Not Eof(TF) Do Begin
|
||||||
|
ReadLn (TF, Str);
|
||||||
|
|
||||||
|
If strStripB(Str, ' ') = '' Then Continue;
|
||||||
|
|
||||||
|
Inc (Count);
|
||||||
|
|
||||||
|
If Count = Pick Then Begin
|
||||||
|
Result := Str;
|
||||||
|
Break;
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Close (TF);
|
||||||
|
End Else
|
||||||
|
Result := mArea.Origin;
|
||||||
|
End;
|
||||||
|
|
||||||
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
||||||
Var
|
Var
|
||||||
TempFile : File;
|
TempFile : File;
|
||||||
|
@ -220,6 +302,43 @@ Begin
|
||||||
Result := True;
|
Result := True;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
Procedure MBaseAssignData (Var User: RecUser; Var Msg: PMsgBaseABS; Var TempBase: RecMessageBase);
|
||||||
|
Var
|
||||||
|
SemFile : Text;
|
||||||
|
Begin
|
||||||
|
Msg^.StartNewMsg;
|
||||||
|
|
||||||
|
If TempBase.Flags And MBRealNames <> 0 Then
|
||||||
|
Msg^.SetFrom(User.RealName)
|
||||||
|
Else
|
||||||
|
Msg^.SetFrom(User.Handle);
|
||||||
|
|
||||||
|
Msg^.SetLocal (True);
|
||||||
|
|
||||||
|
If TempBase.NetType > 0 Then Begin
|
||||||
|
If TempBase.NetType = 3 Then
|
||||||
|
Msg^.SetMailType(mmtNetMail)
|
||||||
|
Else
|
||||||
|
Msg^.SetMailType(mmtEchoMail);
|
||||||
|
|
||||||
|
Msg^.SetOrig(bbsCfg.NetAddress[TempBase.NetAddr]);
|
||||||
|
|
||||||
|
Case TempBase.NetType of
|
||||||
|
1 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileEcho);
|
||||||
|
2 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileNews);
|
||||||
|
3 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileNet);
|
||||||
|
End;
|
||||||
|
|
||||||
|
ReWrite (SemFile);
|
||||||
|
Close (SemFile);
|
||||||
|
End Else
|
||||||
|
Msg^.SetMailType(mmtNormal);
|
||||||
|
|
||||||
|
Msg^.SetPriv (TempBase.Flags and MBPrivate <> 0);
|
||||||
|
Msg^.SetDate (DateDos2Str(CurDateDos, 1));
|
||||||
|
Msg^.SetTime (TimeDos2Str(CurDateDos, 0));
|
||||||
|
End;
|
||||||
|
|
||||||
Function GetTotalFiles (Var TempBase: RecFileBase) : LongInt;
|
Function GetTotalFiles (Var TempBase: RecFileBase) : LongInt;
|
||||||
Begin
|
Begin
|
||||||
Result := 0;
|
Result := 0;
|
||||||
|
|
|
@ -14,6 +14,7 @@ Uses
|
||||||
|
|
||||||
Const
|
Const
|
||||||
QWK_EOL = #13#10;
|
QWK_EOL = #13#10;
|
||||||
|
QWK_CONTROL = 'MYSTICQWK';
|
||||||
|
|
||||||
Type
|
Type
|
||||||
BSingle = Array [0..3] of Byte;
|
BSingle = Array [0..3] of Byte;
|
||||||
|
@ -140,7 +141,7 @@ Begin
|
||||||
Write (TempFile, 'DOOR = ' + mysSoftwareID + QWK_EOL);
|
Write (TempFile, 'DOOR = ' + mysSoftwareID + QWK_EOL);
|
||||||
Write (TempFile, 'VERSION = ' + mysVersion + QWK_EOL);
|
Write (TempFile, 'VERSION = ' + mysVersion + QWK_EOL);
|
||||||
Write (TempFile, 'SYSTEM = ' + mysSoftwareID + ' ' + mysVersion + QWK_EOL);
|
Write (TempFile, 'SYSTEM = ' + mysSoftwareID + ' ' + mysVersion + QWK_EOL);
|
||||||
Write (TempFile, 'CONTROLNAME = MYSTICQWK' + QWK_EOL);
|
Write (TempFile, 'CONTROLNAME = ' + QWK_CONTROL + QWK_EOL);
|
||||||
Write (TempFile, 'CONTROLTYPE = ADD' + QWK_EOL);
|
Write (TempFile, 'CONTROLTYPE = ADD' + QWK_EOL);
|
||||||
Write (TempFile, 'CONTROLTYPE = DROP' + QWK_EOL);
|
Write (TempFile, 'CONTROLTYPE = DROP' + QWK_EOL);
|
||||||
Close (TempFile);
|
Close (TempFile);
|
||||||
|
@ -481,8 +482,190 @@ Begin
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Function TQWKEngine.ProcessReply : Boolean;
|
Function TQWKEngine.ProcessReply : Boolean;
|
||||||
|
|
||||||
|
Procedure QwkControl (Idx: LongInt; Mode: Byte);
|
||||||
|
Var
|
||||||
|
TempBase : RecMessageBase;
|
||||||
|
TempScan : MScanRec;
|
||||||
|
Begin
|
||||||
|
If GetMBaseByIndex(Idx, TempBase) Then Begin
|
||||||
|
GetMessageScan (UserNumber, TempBase, TempScan);
|
||||||
|
|
||||||
|
TempScan.QwkScan := Mode;
|
||||||
|
|
||||||
|
If Mode = 0 Then Inc (RepBaseDel);
|
||||||
|
If Mode = 1 Then Inc (RepBaseAdd);
|
||||||
|
|
||||||
|
PutMessageScan (UserNumber, TempBase, TempScan);
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Var
|
||||||
|
QwkBlock : String[128];
|
||||||
|
QwkHeader : QwkDATHdr;
|
||||||
|
Chunks : SmallInt;
|
||||||
|
Line : String;
|
||||||
|
LineCount : SmallInt;
|
||||||
|
IsControl : Boolean;
|
||||||
|
GotControl : Boolean;
|
||||||
|
ExtFile : Text;
|
||||||
|
Count1 : SmallInt;
|
||||||
|
Count2 : SmallInt;
|
||||||
Begin
|
Begin
|
||||||
Result := False;
|
Result := False;
|
||||||
|
|
||||||
|
DataFile := TFileBuffer.Create(4 * 1024);
|
||||||
|
|
||||||
|
If Not DataFile.OpenStream (FileFind(WorkPath + PacketID + '.msg'), 1, fmOpen, fmRWDN) Then Begin
|
||||||
|
DataFile.Free;
|
||||||
|
|
||||||
|
DirClean (WorkPath, '');
|
||||||
|
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
|
||||||
|
DataFile.ReadBlock(QwkBlock[1], 128);
|
||||||
|
QwkBlock[0] := #128;
|
||||||
|
|
||||||
|
If Pos(strUpper(PacketID), strUpper(QwkBlock)) = 0 Then Begin
|
||||||
|
DataFile.Free;
|
||||||
|
|
||||||
|
DirClean(WorkPath, '');
|
||||||
|
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
|
||||||
|
While Not DataFile.EOF Do Begin
|
||||||
|
DataFile.ReadBlock(QwkHeader, SizeOf(QwkHeader));
|
||||||
|
|
||||||
|
Move (QwkHeader.MsgNum, QwkBlock[1], 7);
|
||||||
|
|
||||||
|
QwkBlock[0] := #7;
|
||||||
|
|
||||||
|
If GetMBaseByIndex(strS2I(QwkBlock), MBase) Then Begin
|
||||||
|
|
||||||
|
If MBaseOpenCreate(MsgBase, MBase, WorkPath) Then Begin
|
||||||
|
|
||||||
|
MBaseAssignData(UserRecord, MsgBase, MBase);
|
||||||
|
|
||||||
|
QwkBlock[0] := #25;
|
||||||
|
Move (QwkHeader.UpTo, QwkBlock[1], 25);
|
||||||
|
MsgBase^.SetTo(strStripR(QwkBlock, ' '));
|
||||||
|
|
||||||
|
Move (QwkHeader.Subject, QwkBlock[1], 25);
|
||||||
|
MsgBase^.SetSubj(strStripR(QwkBlock, ' '));
|
||||||
|
|
||||||
|
Move (QwkHeader.ReferNum, QwkBlock[1], 6);
|
||||||
|
QwkBlock[0] := #6;
|
||||||
|
|
||||||
|
MsgBase^.SetRefer(strS2I(strStripR(QwkBlock, ' ')));
|
||||||
|
|
||||||
|
Move (QwkHeader.NumChunk, QwkBlock[1], 6);
|
||||||
|
|
||||||
|
Chunks := strS2I(QwkBlock) - 1;
|
||||||
|
Line := '';
|
||||||
|
LineCount := 0;
|
||||||
|
IsControl := MsgBase^.GetTo = QWK_CONTROL;
|
||||||
|
GotControl := False;
|
||||||
|
|
||||||
|
// disable control in network packets (for now?)
|
||||||
|
|
||||||
|
If IsNetworked Then
|
||||||
|
IsControl := False;
|
||||||
|
|
||||||
|
If IsControl And ((MsgBase^.GetSubj = 'ADD') or (MsgBase^.GetSubj = 'DROP')) Then
|
||||||
|
QwkControl (MBase.Index, Ord(MsgBase^.GetSubj = 'ADD'));
|
||||||
|
|
||||||
|
For Count1 := 1 to Chunks Do Begin
|
||||||
|
DataFile.ReadBlock (QwkBlock[1], 128);
|
||||||
|
|
||||||
|
QwkBlock[0] := #128;
|
||||||
|
QwkBlock := strStripR(QwkBlock, ' ');
|
||||||
|
|
||||||
|
For Count2 := 1 to Length(QwkBlock) Do Begin
|
||||||
|
If QwkBlock[Count2] = #227 Then Begin
|
||||||
|
Inc (LineCount);
|
||||||
|
|
||||||
|
If (LineCount < 4) and (Copy(Line, 1, 5) = 'From:') Then Begin
|
||||||
|
GotControl := True;
|
||||||
|
|
||||||
|
// ignore from name unless its networked
|
||||||
|
|
||||||
|
If IsNetworked Then
|
||||||
|
MsgBase^.SetTo(strStripB(Copy(Line, 6, Length(Line)), ' '));
|
||||||
|
End Else
|
||||||
|
If (LineCount < 4) and (Copy(Line, 1, 3) = 'To:') Then Begin
|
||||||
|
MsgBase^.SetTo(strStripB(Copy(Line, 4, Length(Line)), ' '));
|
||||||
|
GotControl := True;
|
||||||
|
End Else
|
||||||
|
If (LineCount < 4) and (Copy(Line, 1, 8) = 'Subject:') Then Begin
|
||||||
|
MsgBase^.SetSubj(strStripB(Copy(Line, 9, Length(Line)), ' '));
|
||||||
|
GotControl := True;
|
||||||
|
End Else
|
||||||
|
If GotControl And (Line = '') Then
|
||||||
|
GotControl := False
|
||||||
|
Else
|
||||||
|
MsgBase^.DoStringLn(Line);
|
||||||
|
|
||||||
|
Line := '';
|
||||||
|
End Else
|
||||||
|
Line := Line + QwkBlock[Count2];
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
If Line <> '' Then
|
||||||
|
MsgBase^.DoStringLn(Line);
|
||||||
|
|
||||||
|
If MBase.NetType > 0 Then Begin
|
||||||
|
If IsNetworked Then Begin
|
||||||
|
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
|
||||||
|
MsgBase^.DoStringLn (' * Origin: ' + GetOriginLine(MBase));
|
||||||
|
End Else Begin
|
||||||
|
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
|
||||||
|
MsgBase^.DoStringLn (' * Origin: ' + GetOriginLine(MBase) + ' (' + Addr2Str(MsgBase^.GetOrigAddr) + ')');
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
If Not IsControl Then Begin
|
||||||
|
If HasAccess(Self, MBase.PostACS) Then Begin
|
||||||
|
MsgBase^.WriteMsg;
|
||||||
|
Inc (RepOK); // must increase user and history posts by repOK
|
||||||
|
End Else
|
||||||
|
Inc (RepFailed);
|
||||||
|
End;
|
||||||
|
|
||||||
|
MsgBase^.CloseMsgBase;
|
||||||
|
|
||||||
|
Dispose (MsgBase, Done);
|
||||||
|
End Else
|
||||||
|
Inc (RepFailed);
|
||||||
|
End Else
|
||||||
|
Inc (RepFailed);
|
||||||
|
End;
|
||||||
|
|
||||||
|
DataFile.Free;
|
||||||
|
|
||||||
|
Assign (ExtFile, FileFind(WorkPath + 'todoor.ext'));
|
||||||
|
{$I-} Reset (ExtFile); {$I+}
|
||||||
|
|
||||||
|
If IoResult = 0 Then Begin
|
||||||
|
While Not Eof(ExtFile) Do Begin
|
||||||
|
ReadLn (ExtFile, Line);
|
||||||
|
|
||||||
|
If strWordGet(1, Line, ' ') = 'AREA' Then Begin
|
||||||
|
QwkBlock := strWordGet(3, Line, ' ');
|
||||||
|
|
||||||
|
If Pos('a', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 1);
|
||||||
|
If Pos('D', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 0);
|
||||||
|
End;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Close (ExtFile);
|
||||||
|
End;
|
||||||
|
|
||||||
|
DirClean (WorkPath, '');
|
||||||
|
|
||||||
|
Result := True;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
End.
|
End.
|
||||||
|
|
|
@ -4,10 +4,6 @@ Unit MIS_Client_FTP;
|
||||||
|
|
||||||
{.$DEFINE FTPDEBUG}
|
{.$DEFINE FTPDEBUG}
|
||||||
|
|
||||||
// does not send file/directory datestamps
|
|
||||||
// does not support uploading (need to make bbs functions generic for this
|
|
||||||
// and for mbbsutil -fupload command)
|
|
||||||
|
|
||||||
Interface
|
Interface
|
||||||
|
|
||||||
Uses
|
Uses
|
||||||
|
@ -54,15 +50,17 @@ Type
|
||||||
Function OpenDataSession : Boolean;
|
Function OpenDataSession : Boolean;
|
||||||
Procedure CloseDataSession;
|
Procedure CloseDataSession;
|
||||||
Procedure ResetSession;
|
Procedure ResetSession;
|
||||||
Procedure UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt);
|
Procedure UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt; IsUpload: Boolean);
|
||||||
Function CheckFileLimits (TempFBase: RecFileBase; FDir: RecFileList) : Byte;
|
Function CheckFileLimits (TempFBase: RecFileBase; FDir: RecFileList) : Byte;
|
||||||
Function ValidDirectory (TempBase: RecFileBase) : Boolean;
|
Function ValidDirectory (TempBase: RecFileBase) : Boolean;
|
||||||
Function FindDirectory (Var TempBase: RecFileBase) : LongInt;
|
Function FindDirectory (Var TempBase: RecFileBase) : LongInt;
|
||||||
Function GetQWKName : String;
|
Function GetQWKName : String;
|
||||||
Function GetFTPDate (DD: LongInt) : String;
|
Function GetFTPDate (DD: LongInt) : String;
|
||||||
Procedure SendFile (Str: String);
|
Procedure SendFile (Str: String);
|
||||||
|
Function RecvFile (Str: String; IsAppend: Boolean) : Boolean;
|
||||||
|
|
||||||
Function QWKCreatePacket : Boolean;
|
Function QWKCreatePacket : Boolean;
|
||||||
|
Procedure QWKProcessREP;
|
||||||
|
|
||||||
Procedure cmdUSER;
|
Procedure cmdUSER;
|
||||||
Procedure cmdPASS;
|
Procedure cmdPASS;
|
||||||
|
@ -75,7 +73,7 @@ Type
|
||||||
Procedure cmdLIST;
|
Procedure cmdLIST;
|
||||||
Procedure cmdPWD;
|
Procedure cmdPWD;
|
||||||
Procedure cmdRETR;
|
Procedure cmdRETR;
|
||||||
Procedure cmdSTOR;
|
Procedure cmdSTOR (IsAppend: Boolean);
|
||||||
Procedure cmdSTRU;
|
Procedure cmdSTRU;
|
||||||
Procedure cmdMODE;
|
Procedure cmdMODE;
|
||||||
Procedure cmdSYST;
|
Procedure cmdSYST;
|
||||||
|
@ -161,17 +159,16 @@ Begin
|
||||||
InTransfer := False;
|
InTransfer := False;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Procedure TFTPServer.UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt);
|
Procedure TFTPServer.UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt; IsUpload: Boolean);
|
||||||
Var
|
Var
|
||||||
HistFile: File of RecHistory;
|
HistFile : File of RecHistory;
|
||||||
History : RecHistory;
|
History : RecHistory;
|
||||||
FDirFile: File of RecFileList;
|
FDirFile : File of RecFileList;
|
||||||
UserFile: File of RecUser;
|
UserFile : File of RecUser;
|
||||||
Begin
|
Begin
|
||||||
Inc (FDir.Downloads);
|
// change to getuserbypos
|
||||||
|
|
||||||
Assign (UserFile, bbsConfig.DataPath + 'users.dat');
|
Assign (UserFile, bbsConfig.DataPath + 'users.dat');
|
||||||
ioReset (UserFile, SizeOf(RecUser), fmReadWrite + fmDenyWrite);
|
ioReset (UserFile, SizeOf(RecUser), fmRWDW);
|
||||||
ioSeek (UserFile, UserPos - 1);
|
ioSeek (UserFile, UserPos - 1);
|
||||||
ioRead (UserFile, User);
|
ioRead (UserFile, User);
|
||||||
|
|
||||||
|
@ -179,28 +176,33 @@ Begin
|
||||||
User.CallsToday := 0;
|
User.CallsToday := 0;
|
||||||
User.DLsToday := 0;
|
User.DLsToday := 0;
|
||||||
User.DLkToday := 0;
|
User.DLkToday := 0;
|
||||||
User.TimeLeft := SecLevel.Time
|
User.TimeLeft := SecLevel.Time;
|
||||||
|
User.LastOn := CurDateDos;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
// need to check if it were an upload and do things accordingly
|
If IsUpload Then Begin
|
||||||
|
Inc (User.ULs);
|
||||||
|
Inc (User.ULk, FDir.Size DIV 1024);
|
||||||
|
End Else Begin
|
||||||
|
Inc (FDir.Downloads);
|
||||||
Inc (User.DLs);
|
Inc (User.DLs);
|
||||||
Inc (User.DLsToday);
|
Inc (User.DLsToday);
|
||||||
Inc (User.DLk, FDir.Size DIV 1024);
|
Inc (User.DLk, FDir.Size DIV 1024);
|
||||||
Inc (User.DLkToday, FDir.Size DIV 1024);
|
Inc (User.DLkToday, FDir.Size DIV 1024);
|
||||||
|
|
||||||
|
Assign (FDirFile, bbsConfig.DataPath + TFBase.FileName + '.dir');
|
||||||
|
ioReset (FDirFile, SizeOf(RecFileList), fmRWDW);
|
||||||
|
ioSeek (FDirFile, DirPos - 1);
|
||||||
|
ioWrite (FDirFile, FDir);
|
||||||
|
Close (FDirFile);
|
||||||
|
End;
|
||||||
|
|
||||||
ioSeek (UserFile, UserPos - 1);
|
ioSeek (UserFile, UserPos - 1);
|
||||||
ioWrite (UserFile, User);
|
ioWrite (UserFile, User);
|
||||||
Close (UserFile);
|
Close (UserFile);
|
||||||
|
|
||||||
Assign (FDirFile, bbsConfig.DataPath + TFBase.FileName + '.dir');
|
|
||||||
ioReset (FDirFile, SizeOf(RecFileList), fmReadWrite + fmDenyWrite);
|
|
||||||
ioSeek (FDirFile, DirPos - 1);
|
|
||||||
ioWrite (FDirFile, FDir);
|
|
||||||
Close (FDirFile);
|
|
||||||
|
|
||||||
Assign (HistFile, bbsConfig.DataPath + 'history.dat');
|
Assign (HistFile, bbsConfig.DataPath + 'history.dat');
|
||||||
ioReset (HistFile, SizeOf(RecHistory), fmReadWrite + fmDenyWrite);
|
ioReset (HistFile, SizeOf(RecHistory), fmRWDW);
|
||||||
|
|
||||||
If IoResult <> 0 Then ReWrite(HistFile);
|
If IoResult <> 0 Then ReWrite(HistFile);
|
||||||
|
|
||||||
|
@ -217,11 +219,17 @@ Begin
|
||||||
|
|
||||||
If Eof(HistFile) Then Begin
|
If Eof(HistFile) Then Begin
|
||||||
FillChar(History, SizeOf(History), 0);
|
FillChar(History, SizeOf(History), 0);
|
||||||
|
|
||||||
History.Date := CurDateDos;
|
History.Date := CurDateDos;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Inc (History.Downloads, 1);
|
If IsUpload Then Begin
|
||||||
|
Inc (History.Uploads);
|
||||||
|
Inc (History.UploadKB, FDir.Size DIV 1024);
|
||||||
|
End Else Begin
|
||||||
|
Inc (History.Downloads);
|
||||||
Inc (History.DownloadKB, FDir.Size DIV 1024);
|
Inc (History.DownloadKB, FDir.Size DIV 1024);
|
||||||
|
End;
|
||||||
|
|
||||||
ioWrite (HistFile, History);
|
ioWrite (HistFile, History);
|
||||||
Close (HistFile);
|
Close (HistFile);
|
||||||
|
@ -282,6 +290,7 @@ Begin
|
||||||
|
|
||||||
If DataSocket <> NIL Then Begin
|
If DataSocket <> NIL Then Begin
|
||||||
Client.WriteLine(re_DataOpen);
|
Client.WriteLine(re_DataOpen);
|
||||||
|
|
||||||
Result := True;
|
Result := True;
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
End;
|
||||||
|
@ -301,6 +310,7 @@ Begin
|
||||||
If Not Assigned(DataSocket) Then Begin
|
If Not Assigned(DataSocket) Then Begin
|
||||||
WaitSock.Free;
|
WaitSock.Free;
|
||||||
Client.WriteLine(re_NoData);
|
Client.WriteLine(re_NoData);
|
||||||
|
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
@ -312,6 +322,7 @@ Begin
|
||||||
Client.WriteLine(re_NoData);
|
Client.WriteLine(re_NoData);
|
||||||
DataSocket.Free;
|
DataSocket.Free;
|
||||||
DataSocket := NIL;
|
DataSocket := NIL;
|
||||||
|
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
End;
|
||||||
End;
|
End;
|
||||||
|
@ -420,6 +431,57 @@ Begin
|
||||||
End;
|
End;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
Function TFTPServer.RecvFile (Str: String; IsAppend: Boolean) : Boolean;
|
||||||
|
Var
|
||||||
|
F : File;
|
||||||
|
Buf : Array[1..FileXferSize] of Byte;
|
||||||
|
Res : LongInt;
|
||||||
|
Begin
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
If FileExist(Str) And Not IsAppend Then Begin
|
||||||
|
Client.WriteLine(re_BadFile);
|
||||||
|
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
|
||||||
|
If Not OpenDataSession Then Exit;
|
||||||
|
|
||||||
|
Server.Status ('Receiving: ' + Str);
|
||||||
|
|
||||||
|
InTransfer := True;
|
||||||
|
Result := True;
|
||||||
|
|
||||||
|
Assign (F, Str);
|
||||||
|
|
||||||
|
If FileExist(Str) And IsAppend Then Begin
|
||||||
|
Reset (F, 1);
|
||||||
|
Seek (F, FileSize(F));
|
||||||
|
End Else Begin
|
||||||
|
ReWrite (F, 1);
|
||||||
|
|
||||||
|
IsAppend := False;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Repeat
|
||||||
|
Res := DataSocket.ReadBuf(Buf[1], SizeOf(Buf));
|
||||||
|
|
||||||
|
If Res > 0 Then
|
||||||
|
BlockWrite (F, Buf[1], Res)
|
||||||
|
Else
|
||||||
|
Break;
|
||||||
|
Until False;
|
||||||
|
|
||||||
|
Close (F);
|
||||||
|
|
||||||
|
If Result Then
|
||||||
|
Client.WriteLine (re_XferOK);
|
||||||
|
|
||||||
|
CloseDataSession;
|
||||||
|
|
||||||
|
InTransfer := False;
|
||||||
|
End;
|
||||||
|
|
||||||
Procedure TFTPServer.SendFile (Str: String);
|
Procedure TFTPServer.SendFile (Str: String);
|
||||||
Var
|
Var
|
||||||
F : File;
|
F : File;
|
||||||
|
@ -434,11 +496,14 @@ Begin
|
||||||
|
|
||||||
OpenDataSession;
|
OpenDataSession;
|
||||||
|
|
||||||
|
Server.Status('Sending: ' + Str);
|
||||||
|
|
||||||
While Not Eof(F) Do Begin
|
While Not Eof(F) Do Begin
|
||||||
BlockRead (F, Buf, SizeOf(Buf), Res);
|
BlockRead (F, Buf, SizeOf(Buf), Res);
|
||||||
|
|
||||||
Repeat
|
Repeat
|
||||||
Tmp := DataSocket.WriteBuf(Buf, Res);
|
Tmp := DataSocket.WriteBuf(Buf, Res);
|
||||||
|
|
||||||
Dec (Res, Tmp);
|
Dec (Res, Tmp);
|
||||||
Until Res <= 0;
|
Until Res <= 0;
|
||||||
End;
|
End;
|
||||||
|
@ -475,10 +540,33 @@ Begin
|
||||||
QWK.UpdateLastReadPointers;
|
QWK.UpdateLastReadPointers;
|
||||||
QWK.Free;
|
QWK.Free;
|
||||||
|
|
||||||
Server.Status ('Created packet in ' + TempPath);
|
|
||||||
|
|
||||||
ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1);
|
ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1);
|
||||||
SendFile (TempPath + GetQWKName + '.qwk');
|
SendFile (TempPath + GetQWKName + '.qwk');
|
||||||
|
|
||||||
|
DirClean (TempPath, '');
|
||||||
|
End;
|
||||||
|
|
||||||
|
Procedure TFTPServer.QWKProcessREP;
|
||||||
|
Var
|
||||||
|
QWK : TQwkEngine;
|
||||||
|
Begin
|
||||||
|
// need to change temppath to a unique directory created for this
|
||||||
|
// ftp instance. before that we need to push a unique ID to this
|
||||||
|
// session.
|
||||||
|
|
||||||
|
RecvFile (TempPath + GetQWKName + '.rep', False);
|
||||||
|
ExecuteArchive (TempPath, TempPath + GetQWKName + '.rep', User.Archive, '*', 2);
|
||||||
|
|
||||||
|
QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User);
|
||||||
|
|
||||||
|
QWK.HasAccess := @QWKHasAccess;
|
||||||
|
QWK.IsNetworked := User.Flags AND UserQWKNetwork <> 0;
|
||||||
|
QWK.IsExtended := User.QwkExtended;
|
||||||
|
|
||||||
|
QWK.ProcessReply;
|
||||||
|
QWK.Free;
|
||||||
|
|
||||||
|
// update user stats posts and bbs history if not networked
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Procedure TFTPServer.cmdUSER;
|
Procedure TFTPServer.cmdUSER;
|
||||||
|
@ -753,7 +841,7 @@ Begin
|
||||||
Client.WriteLine(re_BadCommand);
|
Client.WriteLine(re_BadCommand);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Procedure TFTPServer.cmdSTOR;
|
Procedure TFTPServer.cmdSTOR (IsAppend: Boolean);
|
||||||
Var
|
Var
|
||||||
TempPos : LongInt;
|
TempPos : LongInt;
|
||||||
TempBase : RecFileBase;
|
TempBase : RecFileBase;
|
||||||
|
@ -764,6 +852,12 @@ Begin
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
If strUpper(Data) = strUpper(GetQWKName + '.rep') Then Begin
|
||||||
|
QWKProcessREP;
|
||||||
|
|
||||||
|
Exit;
|
||||||
|
End;
|
||||||
|
|
||||||
TempPos := FindDirectory(TempBase);
|
TempPos := FindDirectory(TempBase);
|
||||||
|
|
||||||
If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
|
If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
|
||||||
|
@ -772,17 +866,27 @@ Begin
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Client.WriteLine(re_BadFile);
|
server.status('calling recvfile');
|
||||||
|
|
||||||
//reasons why i haven't finished this (todo):
|
RecvFile ('d:\code\mystic1\temp0\infile.tmp', IsAppend);
|
||||||
|
|
||||||
// ratios
|
// Client.WriteLine(re_BadFile);
|
||||||
// diskspace
|
|
||||||
|
// dreadful things required to do for upload process:
|
||||||
|
|
||||||
|
// find upload base
|
||||||
|
// check diskspace
|
||||||
|
// check slowmedia
|
||||||
|
// check access
|
||||||
|
// check filename length
|
||||||
|
// duplicate file checking
|
||||||
|
// get file
|
||||||
|
// update user statistics
|
||||||
|
// update history statistics
|
||||||
// archive testing
|
// archive testing
|
||||||
// file_id.diz importing
|
// file_id.diz importing
|
||||||
// forcing uploads to upload base (if non-zero)
|
|
||||||
// duplicate file checking
|
// other things: add no desc and ftp test batch to configuration?
|
||||||
// upload statistic tracking
|
|
||||||
End;
|
End;
|
||||||
|
|
||||||
Procedure TFTPServer.cmdRETR;
|
Procedure TFTPServer.cmdRETR;
|
||||||
|
@ -818,6 +922,7 @@ Begin
|
||||||
|
|
||||||
If WildMatch(FileMask, Dir.FileName, False) Then Begin
|
If WildMatch(FileMask, Dir.FileName, False) Then Begin
|
||||||
Found := DirFile.FilePosRecord;
|
Found := DirFile.FilePosRecord;
|
||||||
|
|
||||||
Break;
|
Break;
|
||||||
End;
|
End;
|
||||||
End;
|
End;
|
||||||
|
@ -833,7 +938,7 @@ Begin
|
||||||
Case CheckFileLimits(TempBase, Dir) of
|
Case CheckFileLimits(TempBase, Dir) of
|
||||||
0 : Begin
|
0 : Begin
|
||||||
SendFile (TempBase.Path + Dir.FileName);
|
SendFile (TempBase.Path + Dir.FileName);
|
||||||
UpdateUserStats (TempBase, Dir, Found);
|
UpdateUserStats (TempBase, Dir, Found, False);
|
||||||
End;
|
End;
|
||||||
1 : Client.WriteLine(re_NoAccess);
|
1 : Client.WriteLine(re_NoAccess);
|
||||||
2 : Client.WriteLine(re_DLLimit);
|
2 : Client.WriteLine(re_DLLimit);
|
||||||
|
@ -956,6 +1061,7 @@ Begin
|
||||||
Server.Status ('Cmd: ' + Cmd + ' Data: ' + Data);
|
Server.Status ('Cmd: ' + Cmd + ' Data: ' + Data);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
//If Cmd = 'APPE' Then cmdSTOR(True) Else
|
||||||
If Cmd = 'CDUP' Then cmdCDUP Else
|
If Cmd = 'CDUP' Then cmdCDUP Else
|
||||||
If Cmd = 'CWD' Then cmdCWD Else
|
If Cmd = 'CWD' Then cmdCWD Else
|
||||||
If Cmd = 'DELE' Then Client.WriteLine(re_NoAccess) Else
|
If Cmd = 'DELE' Then Client.WriteLine(re_NoAccess) Else
|
||||||
|
@ -974,7 +1080,8 @@ Begin
|
||||||
If Cmd = 'RETR' Then cmdRETR Else
|
If Cmd = 'RETR' Then cmdRETR Else
|
||||||
If Cmd = 'RMD' Then Client.WriteLine(re_NoAccess) Else
|
If Cmd = 'RMD' Then Client.WriteLine(re_NoAccess) Else
|
||||||
If Cmd = 'SIZE' Then cmdSIZE Else
|
If Cmd = 'SIZE' Then cmdSIZE Else
|
||||||
If Cmd = 'STOR' Then cmdSTOR Else
|
If Cmd = 'STOR' Then cmdSTOR(False) Else
|
||||||
|
// implement STOU which in turn calls cmdSTOR after getting filename
|
||||||
If Cmd = 'STRU' Then cmdSTRU Else
|
If Cmd = 'STRU' Then cmdSTRU Else
|
||||||
If Cmd = 'SYST' Then cmdSYST Else
|
If Cmd = 'SYST' Then cmdSYST Else
|
||||||
If Cmd = 'TYPE' Then cmdTYPE Else
|
If Cmd = 'TYPE' Then cmdTYPE Else
|
||||||
|
|
|
@ -3605,6 +3605,12 @@
|
||||||
the file base editor for their names to be automatically changed.
|
the file base editor for their names to be automatically changed.
|
||||||
|
|
||||||
+ Users can now download QWK packets using the FTP server. A QWK packet
|
+ Users can now download QWK packets using the FTP server. A QWK packet
|
||||||
filename will be shown in all FTP listings.
|
filename will be shown in all FTP listings. If the user is flagged as a
|
||||||
|
FTP network account, their handle will be used as the BBSID for the QWK
|
||||||
|
packet (handle.qwk).
|
||||||
|
|
||||||
|
+ Users can now upload QWK reply packets using the FTP server. If the user
|
||||||
|
is flagged as a FTP network account, their reply packet will need to be
|
||||||
|
"handle.rep".
|
||||||
|
|
||||||
<ALPHA 37 RELEASED>
|
<ALPHA 37 RELEASED>
|
||||||
|
|
Loading…
Reference in New Issue