PROTEDIT.PAS

11.8 KB 422360d218bddf7a…
unit protedit;
     interface uses crt,dos,gentypes,configrt,subs1,subs2,gensubs,windows;
Procedure cProtocolEdit;
implementation
var cValue      : array[1..2] of byte;
   cSelectChar  : array[1..26] of char;
Function cInputStr(x,y,fg,bg,len : byte; bufStr : lStr) : lStr;
var iPos     : byte;
    iStr     : lStr;
    iChar    : char;
begin
cChange := true;
iStr := bufStr;
goxy(x,y);
for iPos := 1 to len do multicolor('|B0|07'+#32);goxy(x,y);
inputbox2(len, bufStr);
if inpt<>'<<undo>>' then cInputStr := inpt else
                         cInputStr := iStr;
end;

Function cInputCh(x,y,fg,bg,len : byte;bufStr : char) : char;
 var s : string;
 begin
 s := cInputStr(x,y,fg,bg,1,bufStr);
 cInputCh := s[1];
 end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function cSelectShit(cOptions : byte) : char;
var cInKey : char;
    cKill  : boolean;
  {:::::::::::::::::::::::::::::::::::::::::::::::::::::::}
 Procedure cShowSelection;
  begin
  goXY(1,2+cValue[1]);multicolor('|08(|15'+chr(cValue[1]+96)+'|08)');
  goXY(1,2+cValue[2]);multicolor('|B7 |08'+chr(cValue[2]+96)+'|B7 ');
  goXY(1,1);
  end;
  {:::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin
 cShowSelection;
 repeat
 cInKey := upCase(ArrowKey(True));
  case cInKey of
    ^A   : begin
           cValue[1] := cValue[2];
           if (cValue[1]<>1) then dec(cValue[2]);
           cShowSelection;
           end;
    ^B   : begin
           cValue[1] := cValue[2];
           if (cValue[1]<>cOptions) then inc(cValue[2]);
           cShowSelection;
           end;
  ']'    : begin
           cSelectShit := ']';
           cKill := true;
           end;
  '['    : begin
           cSelectShit := '[';
           cKill := true;
           end;
  ' '    : begin
           cSelectShit := #32;
           cKill := true;
           end;
#27,'X'  : begin
           cSelectShit := 'X';
           cKill := True;
           end;
 'A'..'Z': begin
            if (ord(cInkey)<=64+cOptions) then
             begin
             cValue[1] := cValue[2];
             cValue[2] := ord(cInKey)-64;
             cShowSelection;
             cSelectShit := cInkey;
             cKill := true;
             end;
           end;
  #13    : begin
           cSelectShit := cSelectChar[cValue[2]];
           cKill := true;
           end;
  #27    : begin
           cSelectShit := #0;
           cKill := true;
           end;
   end;
 until (cKill=true);
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}

Procedure cProtocolEdit;
const
 pBarData   : array[1..5] of string = (
  '     edit upload protocols     ',
  '    edit download protocols    ',
  '  edit batch upload protocols  ',
  ' edit batch download protocols ',
  '     quit protocol editor      ');
type
 pDataArray = array[1..26] of protoRec;
var
 pBarShit : array[1..2] of byte;
 pData    : ^pDataArray;
 pCurrent : 1..26;
 pTotal   : 1..26;

          procedure pDrawScreens(scrn : byte);
           var x : byte;
           begin
            if (scrn=1) then
             begin
             ansiCls;
       multiColor('|08┌|07:|15: |03infusion protocol editor |15:|07:|08────────────────────────────────────────────────┐');
       multiColor('|08└──────────────────────────────────────────────────────────────────────────────┘');
             for x := 1 to 5 do
              begin
              goXY(25,2+x);
              multiColor('|07|B0'+pBarData[x]);
              end;
             goXY(1,8);
             multiColor('|08┌──────────────────────────────────────────────────────────────────────────────┐');
       multiColor('|08└|07:|15: |03use arrow keys to select protocol type to edit, enter edits |15:|07:|08─────────────┘');
             end else
            if (scrn=2) then
             begin
             ansiCls;
       multiColor('|08┌|07:|15: |03infusion protocol editor |15:|07:|08────────────────────────────────────────────────┐');
       multiColor('|08└──────────────────────────────────────────────────────────────────────────────┘');
             goXY(40,1);multiColor('|03: '+strr(pCurrent)+' of '+strr(pTotal)+' :');
             goXY(1,3); multiColor('|08(|15a|08) |07Protocol Description   |08: |15'+pData^[pCurrent].desc);
             goXY(1,4); multiColor('|08(|15b|08) |07Activation Character   |08: |15'+pData^[pCurrent].letter);
             goXY(1,5); multiColor('|08(|15c|08) |07Protocol Filename      |08: |15'+pData^[pCurrent].progName);
             goXY(1,6); multiColor('|08(|15d|08) |07Protocol Command Line  |08: |15'+pData^[pCurrent].commFmt);
             goXY(1,7); multiColor('|08(|15e|08) |07Add Protocol');
             goXY(1,8); multiColor('|08(|15f|08) |07Delete Protocol');
             goXY(1,9); multiColor('|08(|15g|08) |07Next Protocol');
             goXy(1,10);multiColor('|08(|15h|08) |07Previous Protocol|CR');
     multiColor('|08┌──────────────────────────────────────────────────────────────────────────────┐');
     multiColor('|08└|07:|15: |03arrow keys navigate, X exits, hot keys jump to editing field |15:|07:|08────────────┘');
             end;
           end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
           procedure pLoadData(protType : byte);
            const
            files  : array[1..4] of string[12]
                     = ('PROT_R.DAT','PROT_S.DAT','PROT_U.DAT','PROT_D.DAT');
           var
            pFile  : file;
            pCount : byte;
                           procedure pMakeNew;
                            begin
                            assign(pFile,cfg.dataDir+files[protType]);
                            rewrite(pFile,1);
                            fillChar(pData^,sizeOf(pData^),0);
                            pData^[1].desc     := 'GSZ Registered';
                            pData^[1].letter   := 'Z';
                            pData^[1].progName := 'GSZ.EXE';
                            pData^[1].commFmt   := 'Enter Format';
                            blockWrite(pFile,pData^[1],sizeOf(protoRec));
                            close(pData);
                            end;
           begin
            if not exist(cfg.dataDir+files[protType]) then
               pMakeNew;
            assign(pFile,cfg.dataDir+files[protType]);
            reset(pFile,1);
            fillChar(pData^,sizeOf(pData^),0);
             pTotal := fileSize(pFile) div sizeOf(protoRec);
             for pCount := 1 to pTotal do blockRead(pFile,pData^[pCount],sizeOf(protoRec));
            close(pFile);
           end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
           procedure pEditShit(num : byte);
            begin
             case num of
             1 : pData^[pCurrent].desc     := cInputStr(30,3,00,7,30,pData^[pCurrent].desc);
             2 : pData^[pCurrent].letter   := cInputCh (30,4,00,7,01,pData^[pCurrent].letter);
             3 : pData^[pCurrent].progName := cInputStr(30,5,00,7,12,pData^[pCurrent].progName);
             4 : pData^[pCurrent].commFmt  := cInputStr(30,6,00,7,50,pData^[pCurrent].commFmt);
             end;
             if (cChange=true) then pDrawScreens(2);cChange := false;
            end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
          procedure pPromptSave(protType : byte);
          const
            files  : array[1..4] of string[12]
                     = ('PROT_R.DAT','PROT_S.DAT','PROT_U.DAT','PROT_D.DAT');
          var pFile : file;
           begin
           goXY(1,15);writeStr('save yer changes - !');
           if yes then begin
           assign(pFile,cfg.dataDir+files[protType]);
           rewrite(pFile,1);
           blockWrite(pFile,pData^,sizeOf(protoRec)*pTotal);
           close(pFile);
           end;
           end;

           procedure pAddProtocol;
            begin
            if (pTotal<26) then
             begin
             inc(pTotal);
             pData^[pTotal].desc    := 'New Protocol';
             pData^[pTotal].letter  := '?';
             pData^[pTotal].progName:= 'PROTOCOL.EXE';
             pData^[pTotal].commFmt := 'Enter Command Line';
             pCurrent := pTotal;
             pDrawScreens(2);
             end;
            end;

          procedure pDeleteProtocol;
           var pCount : byte;
           begin
            goXY(1,13);writeStr('verify protocol #'+strr(pCurrent)+'''s deletion - !');
             if yes then
              begin
              for pCount := pCurrent to pTotal do
                  pData^[pCount] := pData^[pCount+1];
              dec(pTotal);
              if pCurrent > pTotal then pCurrent := pTotal;
              pDrawScreens(2);
              end;
              goXY(1,13);sendFull('                                        ');
            end;

           procedure pSelectShit(protType : byte);
           var
            pDone : boolean;
            pKey  : char;
           begin
            pCurrent := 1;
            pLoadData(protType);
            pDrawScreens(2);
             repeat
             pKey := cSelectShit(8);
              case pKey of
              'A'..'D' : begin
                         pEditShit(ord(pKey)-64);
                         end;
              'G',']'  : begin
                         if (pCurrent<pTotal) then
                           begin
                           inc(pCurrent);
                           pDrawScreens(2);
                           end;
                         end;
              'H','['  : begin
                         if (pCurrent>1) then
                           begin
                           dec(pCurrent);
                           pDrawScreens(2);
                           end;
                         end;
              'E'      : pAddProtocol;
              'F'      : pDeleteProtocol;
              'X'      : pDone := true;
              end;
             until (pDone=true);
           pPromptSave(protType);
           pDrawScreens(1);
           end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
           procedure pSelectEntry;

                     procedure pShowBars;
                      begin
                      goXY(25,2+pBarShit[1]);
                      multiColor('|07|B0'+pBarData[pBarShit[1]]);
                      goXY(25,2+pBarShit[2]);
                      multiColor('|15|B3'+pBarData[pBarShit[2]]);
                      goXY(1,1);
                      end;

           var pDone  : boolean;
               pInKey : char;
            begin
             pDrawScreens(1);
             pBarShit[1] := 1;pBarShit[2] := 1;
              pShowBars;
              repeat
              pInKey := arrowKey(true);
               case upCase(pInKey) of
               ^A   : begin
                      pBarShit[1] := pBarShit[2];
                      if (pBarShit[2]>1) then dec(pBarShit[2]);
                      pShowBars;
                      end;
               ^B   : begin
                      pBarShit[1] := pBarShit[2];
                      if (pBarShit[2]<5) then inc(pBarShit[2]);
                      pShowBars;
                      end;
               ^M   : begin
                      if (pBarShit[2]=1) then pSelectShit(1);
                      if (pBarShit[2]=2) then pSelectShit(2);
                      if (pBarShit[2]=3) then pSelectShit(3);
                      if (pBarShit[2]=4) then pSelectShit(4);
                      if (pBarShit[2]=5) then pDone := true;
                      pShowBars;
                      end;
               end;
              until (pDone=true);
            end;
 begin
 inConfigMode := true;
 new(pData);
 pSelectEntry;
 dispose(pData);
 inConfigMode := false;
 end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
end.