364 lines
12 KiB
Plaintext
364 lines
12 KiB
Plaintext
|
{$IFDEF WIN32}
|
||
|
|
{$I DEFINES.INC}
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||
|
|
|
||
|
|
UNIT SysOp2K;
|
||
|
|
|
||
|
|
INTERFACE
|
||
|
|
|
||
|
|
PROCEDURE DisplayArcs;
|
||
|
|
PROCEDURE DisplayCmt;
|
||
|
|
PROCEDURE ArchiveConfiguration;
|
||
|
|
|
||
|
|
IMPLEMENTATION
|
||
|
|
|
||
|
|
USES
|
||
|
|
Common;
|
||
|
|
|
||
|
|
|
||
|
|
PROCEDURE DisplayArcs;
|
||
|
|
VAR
|
||
|
|
RecNumToList: Byte;
|
||
|
|
BEGIN
|
||
|
|
Abort := FALSE;
|
||
|
|
Next := FALSE;
|
||
|
|
PrintACR('^0 ##^4:^3Ext^4:^3Compression cmdline ^4:^3Decompression cmdline ^4:^3Success Code');
|
||
|
|
PrintACR('^4 ==:===:=========================:=========================:============');
|
||
|
|
RecNumToList := 1;
|
||
|
|
WHILE (RecNumToList <= NumArcs) AND (NOT Abort) AND (NOT HangUp) DO
|
||
|
|
BEGIN
|
||
|
|
WITH General.FileArcInfo[RecNumToList] DO
|
||
|
|
PrintACR(AOnOff(Active,'^5+','^1-')+
|
||
|
|
'^0'+PadRightInt(RecNumToList,2)+
|
||
|
|
' ^3'+PadLeftStr(Ext,3)+
|
||
|
|
' ^5'+PadLeftStr(ArcLine,25)+
|
||
|
|
' '+PadLeftStr(UnArcLine,25)+
|
||
|
|
' '+AOnOff(SuccLevel <> - 1,IntToStr(SuccLevel),'-1 (ignores)'));
|
||
|
|
Inc(RecNumToList);
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE DisplayCmt;
|
||
|
|
VAR
|
||
|
|
RecNumToList: Byte;
|
||
|
|
BEGIN
|
||
|
|
FOR RecNumToList := 1 TO 3 DO
|
||
|
|
PrintACR('^1'+IntToStr(RecNumToList)+'. Archive comment file: ^5'+
|
||
|
|
AOnOff(General.FileArcComment[RecNumToList] <> '',
|
||
|
|
General.FileArcComment[RecNumToList],'*None*'));
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE ArchiveConfiguration;
|
||
|
|
VAR
|
||
|
|
TempArchive: FileArcInfoRecordType;
|
||
|
|
Cmd: Char;
|
||
|
|
RecNumToList: Byte;
|
||
|
|
Changed : Boolean;
|
||
|
|
|
||
|
|
FUNCTION DisplayArcStr(S: AStr): AStr;
|
||
|
|
BEGIN
|
||
|
|
IF (S <> '') THEN
|
||
|
|
DisplayArcStr := S
|
||
|
|
ELSE
|
||
|
|
DisplayArcStr := '*None*';
|
||
|
|
IF (S[1] = '/') THEN
|
||
|
|
BEGIN
|
||
|
|
S := '"'+S+'" - ';
|
||
|
|
CASE s[3] OF
|
||
|
|
'1' : DisplayArcStr := S + '*Internal* ZIP viewer';
|
||
|
|
'2' : DisplayArcStr := S + '*Internal* ARC/PAK viewer';
|
||
|
|
'3' : DisplayArcStr := S + '*Internal* ZOO viewer';
|
||
|
|
'4' : DisplayArcStr := S + '*Internal* LZH viewer';
|
||
|
|
'5' : DisplayArcStr := S + '*Internal* ARJ viewer';
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE InitArchiveVars(VAR Archive: FileArcInfoRecordType);
|
||
|
|
BEGIN
|
||
|
|
FillChar(Archive,SizeOf(Archive),0);
|
||
|
|
WITH Archive DO
|
||
|
|
BEGIN
|
||
|
|
Active := FALSE;
|
||
|
|
Ext := 'AAA';
|
||
|
|
ListLine := '';
|
||
|
|
ArcLine := '';
|
||
|
|
UnArcLine := '';
|
||
|
|
TestLine := '';
|
||
|
|
CmtLine := '';
|
||
|
|
SuccLevel := -1;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE DeleteArchive(TempArchive1: FileArcInfoRecordType; RecNumToDelete: Byte);
|
||
|
|
VAR
|
||
|
|
RecNum: Byte;
|
||
|
|
BEGIN
|
||
|
|
IF (NumArcs = 0) THEN
|
||
|
|
Messages(4,0,'archive records')
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
RecNumToDelete := 0;
|
||
|
|
InputByteWOC('%LFArchive to delete?',RecNumToDelete,[NumbersOnly],1,NumArcs);
|
||
|
|
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumArcs) THEN
|
||
|
|
BEGIN
|
||
|
|
TempArchive1 := General.FileArcInfo[RecNumToDelete];
|
||
|
|
Print('%LFArchive: ^5'+TempArchive1.Ext);
|
||
|
|
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||
|
|
BEGIN
|
||
|
|
Print('%LF[> Deleting archive record ...');
|
||
|
|
FOR RecNum := RecNumToDelete TO (NumArcs - 1) DO
|
||
|
|
General.FileArcInfo[RecNum] := General.FileArcInfo[RecNum + 1];
|
||
|
|
General.FileArcInfo[NumArcs].Ext := '';
|
||
|
|
Dec(NumArcs);
|
||
|
|
SysOpLog('* Deleted archive: ^5'+TempArchive1.Ext);
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE CheckArchive(Archive: FileArcInfoRecordType; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||
|
|
VAR
|
||
|
|
Counter: Byte;
|
||
|
|
BEGIN
|
||
|
|
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||
|
|
CASE Counter OF
|
||
|
|
1 : IF (Archive.Ext = '') OR (Archive.Ext = 'AAA') THEN
|
||
|
|
BEGIN
|
||
|
|
Print('%LF^7The archive extension is invalid!^1');
|
||
|
|
OK := FALSE;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE EditArchive(TempArchive1: FileArcInfoRecordType; VAR Archive: FileArcInfoRecordType; VAR Cmd1: Char;
|
||
|
|
VAR RecNumToEdit: Byte; VAR Changed1: Boolean; Editing: Boolean);
|
||
|
|
VAR
|
||
|
|
CmdStr: AStr;
|
||
|
|
Ok: Boolean;
|
||
|
|
BEGIN
|
||
|
|
WITH Archive DO
|
||
|
|
REPEAT
|
||
|
|
IF (Cmd1 <> '?') THEN
|
||
|
|
BEGIN
|
||
|
|
Abort := FALSE;
|
||
|
|
Next := FALSE;
|
||
|
|
CLS;
|
||
|
|
IF (Editing) THEN
|
||
|
|
PrintACR('^5Editing archive #'+IntToStr(RecNumToEdit)+
|
||
|
|
' of '+IntToStr(NumArcs))
|
||
|
|
ELSE
|
||
|
|
PrintACR('^5Inserting archive #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumArcs + 1));
|
||
|
|
NL;
|
||
|
|
PrintACR('^11. Active : ^5'+ShowYesNo(Active));
|
||
|
|
PrintACR('^12. Extension name : ^5'+Ext);
|
||
|
|
PrintACR('^13. Interior list method : ^5'+DisplayArcStr(ListLine));
|
||
|
|
PrintACR('^14. Compression cmdline : ^5'+DisplayArcStr(ArcLine));
|
||
|
|
PrintACR('^15. Decompression cmdline : ^5'+DisplayArcStr(UnArcLine));
|
||
|
|
PrintACR('^16. File testing cmdline : ^5'+DisplayArcStr(TestLine));
|
||
|
|
PrintACR('^17. Add comment cmdline : ^5'+DisplayArcStr(CmtLine));
|
||
|
|
PrintACR('^18. Errorlevel for success : ^5'++AOnOff(SuccLevel <> - 1,IntToStr(SuccLevel),'-1 (ignores)'));
|
||
|
|
END;
|
||
|
|
IF (NOT Editing) THEN
|
||
|
|
CmdStr := '12345678'
|
||
|
|
ELSE
|
||
|
|
CmdStr := '12345678[]FJL';
|
||
|
|
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr+^M,TRUE,TRUE);
|
||
|
|
CASE Cmd1 OF
|
||
|
|
'1' : BEGIN
|
||
|
|
Active := NOT Active;
|
||
|
|
Changed1 := TRUE;
|
||
|
|
END;
|
||
|
|
'2' : REPEAT
|
||
|
|
TempArchive1.Ext := Ext;
|
||
|
|
Ok := TRUE;
|
||
|
|
InputWN1('%LFNew extension: ',Ext,(SizeOf(Ext) - 1),[InterActiveEdit,UpperOnly],Changed1);
|
||
|
|
CheckArchive(Archive,1,1,Ok);
|
||
|
|
IF (NOT Ok) THEN
|
||
|
|
Ext := TempArchive1.Ext;
|
||
|
|
UNTIL (Ok) OR (HangUp);
|
||
|
|
'3' : InputWN1('%LFNew interior list method: ',ListLine,(SizeOf(ListLine) - 1),[InterActiveEdit],Changed1);
|
||
|
|
'4' : InputWN1('%LFNew compression command line: ',ArcLine,(SizeOf(ArcLine) - 1),[InterActiveEdit],Changed1);
|
||
|
|
'5' : InputWN1('%LFNew decompression command line: ',UnArcLine,(SizeOf(UnArcLine) - 1),
|
||
|
|
[InterActiveEdit],Changed1);
|
||
|
|
'6' : InputWN1('%LFNew file testing command line: ',TestLine,(SizeOf(TestLine) - 1),
|
||
|
|
[InterActiveEdit],Changed1);
|
||
|
|
'7' : InputWN1('%LFNew add comment command line: ',CmtLine,(SizeOf(CmtLine) - 1),[InterActiveEdit],Changed1);
|
||
|
|
'8' : InputIntegerWC('%LFNew errorlevel for success',SuccLevel,[DisplayValue,NumbersOnly],-1,255,Changed1);
|
||
|
|
'[' : IF (RecNumToEdit > 1) THEN
|
||
|
|
Dec(RecNumToEdit)
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
Messages(2,0,'');
|
||
|
|
Cmd1 := #0;
|
||
|
|
END;
|
||
|
|
']' : IF (RecNumToEdit < NumArcs) THEN
|
||
|
|
Inc(RecNumToEdit)
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
Messages(3,0,'');
|
||
|
|
Cmd1 := #0;
|
||
|
|
END;
|
||
|
|
'F' : IF (RecNumToEdit <> 1) THEN
|
||
|
|
RecNumToEdit := 1
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
Messages(2,0,'');
|
||
|
|
Cmd1 := #0;
|
||
|
|
END;
|
||
|
|
'J' : BEGIN
|
||
|
|
InputByteWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumArcs);
|
||
|
|
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumArcs) THEN
|
||
|
|
Cmd1 := #0;
|
||
|
|
END;
|
||
|
|
'L' : IF (RecNumToEdit <> NumArcs) THEN
|
||
|
|
RecNumToEdit := NumArcs
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
Messages(3,0,'');
|
||
|
|
Cmd1 := #0;
|
||
|
|
END;
|
||
|
|
'?' : BEGIN
|
||
|
|
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||
|
|
Print('^31^1-^38^1:Modify item');
|
||
|
|
IF (NOT Editing) THEN
|
||
|
|
LCmds(20,3,'Quit and save','')
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
LCmds(20,3,'[Back entry',']Forward entry');
|
||
|
|
LCmds(20,3,'First entry in list','Jump to entry');
|
||
|
|
LCmds(20,3,'Last entry in list','Quit and save');
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE InsertArchive(TempArchive1: FileArcInfoRecordType; Cmd1: Char; RecNumToInsertBefore: Byte);
|
||
|
|
VAR
|
||
|
|
RecNum,
|
||
|
|
RecNumToEdit: Byte;
|
||
|
|
Ok,
|
||
|
|
Changed1: Boolean;
|
||
|
|
BEGIN
|
||
|
|
IF (NumArcs = MaxArcs) THEN
|
||
|
|
Messages(5,MaxArcs,'archive records')
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
RecNumToInsertBefore := 0;
|
||
|
|
InputByteWOC('%LFArchive to insert before?',RecNumToInsertBefore,[NumbersOnly],1,(NumArcs + 1));
|
||
|
|
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumArcs + 1)) THEN
|
||
|
|
BEGIN
|
||
|
|
InitArchiveVars(TempArchive1);
|
||
|
|
IF (RecNumToInsertBefore = 1) THEN
|
||
|
|
RecNumToEdit := 1
|
||
|
|
ELSE IF (RecNumToInsertBefore = (NumArcs + 1)) THEN
|
||
|
|
RecNumToEdit := (NumArcs + 1)
|
||
|
|
ELSE
|
||
|
|
RecNumToEdit := RecNumToInsertBefore;
|
||
|
|
REPEAT
|
||
|
|
OK := TRUE;
|
||
|
|
EditArchive(TempArchive1,TempArchive1,Cmd1,RecNumToEdit,Changed1,FALSE);
|
||
|
|
CheckArchive(TempArchive1,1,2,Ok);
|
||
|
|
IF (NOT OK) THEN
|
||
|
|
IF (NOT PYNQ('%LFContinue inserting archive? ',0,TRUE)) THEN
|
||
|
|
Abort := TRUE;
|
||
|
|
UNTIL (OK) OR (Abort) OR (HangUp);
|
||
|
|
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||
|
|
BEGIN
|
||
|
|
Print('%LF[> Inserting archive record ...');
|
||
|
|
IF (RecNumToInsertBefore <> (NumArcs + 1)) THEN
|
||
|
|
FOR RecNum := (NumArcs + 1) DOWNTO (RecNumToInsertBefore + 1) DO
|
||
|
|
General.FileArcInfo[RecNum] := General.FileArcInfo[RecNum - 1];
|
||
|
|
General.FileArcInfo[RecNumToInsertBefore] := TempArchive1;
|
||
|
|
Inc(NumArcs);
|
||
|
|
SysOpLog('* Inserted archive: ^5'+TempArchive1.Ext);
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
PROCEDURE ModifyArchive(TempArchive1: FileArcInfoRecordType; Cmd1: Char; RecNumToEdit: Byte);
|
||
|
|
VAR
|
||
|
|
Archive: FileArcInfoRecordType;
|
||
|
|
SaveRecNumToEdit: Byte;
|
||
|
|
OK,
|
||
|
|
Changed1: Boolean;
|
||
|
|
BEGIN
|
||
|
|
IF (NumArcs = 0) THEN
|
||
|
|
Messages(4,0,'archive records')
|
||
|
|
ELSE
|
||
|
|
BEGIN
|
||
|
|
RecNumToEdit := 0;
|
||
|
|
InputByteWOC('%LFArchive to modify?',RecNumToEdit,[NumbersOnly],1,NumArcs);
|
||
|
|
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumArcs) THEN
|
||
|
|
BEGIN
|
||
|
|
SaveRecNumToEdit := 0;
|
||
|
|
Cmd1 := #0;
|
||
|
|
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||
|
|
BEGIN
|
||
|
|
IF (SaveRecNumToEdit <> RecNumToEdit) THEN
|
||
|
|
BEGIN
|
||
|
|
Archive := General.FileArcInfo[RecNumToEdit];
|
||
|
|
SaveRecNumToEdit := RecNumToEdit;
|
||
|
|
Changed1 := FALSE;
|
||
|
|
END;
|
||
|
|
REPEAT
|
||
|
|
Ok := TRUE;
|
||
|
|
EditArchive(TempArchive1,Archive,Cmd1,RecNumToEdit,Changed1,TRUE);
|
||
|
|
CheckArchive(Archive,1,2,Ok);
|
||
|
|
IF (NOT OK) THEN
|
||
|
|
BEGIN
|
||
|
|
PauseScr(FALSE);
|
||
|
|
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||
|
|
RecNumToEdit := SaveRecNumToEdit;
|
||
|
|
END;
|
||
|
|
UNTIL (Ok) OR (HangUp);
|
||
|
|
IF (Changed1) THEN
|
||
|
|
BEGIN
|
||
|
|
General.FileArcInfo[SaveRecNumToEdit] := Archive;
|
||
|
|
Changed1 := FALSE;
|
||
|
|
SysOpLog('* Modified archive: ^5'+Archive.Ext);
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
|
||
|
|
BEGIN
|
||
|
|
Cmd := #0;
|
||
|
|
REPEAT
|
||
|
|
IF (Cmd <> '?') THEN
|
||
|
|
BEGIN
|
||
|
|
CLS;
|
||
|
|
DisplayArcs;
|
||
|
|
NL;
|
||
|
|
DisplayCmt;
|
||
|
|
END;
|
||
|
|
LOneK('%LFArchive editor [^5?^4=^5Help^4]: ',Cmd,'QDIM123?'^M,TRUE,TRUE);
|
||
|
|
CASE Cmd OF
|
||
|
|
'D' : DeleteArchive(TempArchive,RecNumToList);
|
||
|
|
'I' : InsertArchive(TempArchive,Cmd,RecNumToList);
|
||
|
|
'M' : ModifyArchive(TempArchive,Cmd,RecNumToList);
|
||
|
|
'1'..'3' :
|
||
|
|
BEGIN
|
||
|
|
Changed := FALSE;
|
||
|
|
InputWNWC('%LFNew comment file #'+IntToStr(Ord(Cmd) - 48)+': ',General.FileArcComment[Ord(Cmd) - 48],40,Changed);
|
||
|
|
IF (Changed) THEN
|
||
|
|
SysOpLog('* Modified comment: ^5'+IntToStr(Ord(Cmd) - 48)+'.');
|
||
|
|
END;
|
||
|
|
'?' : BEGIN
|
||
|
|
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||
|
|
Print('^1(^3?^1)Help/First archive');
|
||
|
|
Print('^31^1-^33^1:Modify Item');
|
||
|
|
LCmds(16,3,'Delete archive','Insert archive');
|
||
|
|
LCmds(16,3,'Modify archive','Quit');
|
||
|
|
END;
|
||
|
|
END;
|
||
|
|
UNTIL (Cmd = 'Q') OR (HangUp);
|
||
|
|
END;
|
||
|
|
|
||
|
|
END.
|