program Create_Qmodem_Pcboard_Script;

{ Original program was donated to public domain by: David W. Terry            }
{                                                   3036 Putnam Ct.           }
{                                                   West Valley City, Ut 84120}
{                                                   Feb. 26, 1985             }
{                                                                             }
{ If you make changes and distribute your changed code, Please include some   }
{ comments to that effect....                                                 }
{                                                                             }
{ Revised by Chuck Seyboldt to create u/l-d/l & logoff segments ONLY          }
{ Modified for PCBoard v12 and 14                   Jan. 01, 1989             }
{ Modified for Qmodem  v4.0                         Feb. 26, 1989             }

type
  str1  = string[1];
  str3  = string[3];
  str12 = string[12];
  str20 = string[20];
  str80 = string[80];

var
  Command,              { Menu selection variable                             }
  FileN1,               { Upcase values of optional file identifier           }
  FileN2:        char;  {                                                     }
  TransferType,         { Type of File Transfer desired (Z,O,Y,G,C)           }
  QTransfer:     str1;  { Qmodem's Transfer type (Z,O,O,G,C)                  }
  FileName:      str12; { up/download names                                   }
  FileDesc:      str80; { Description of file to be uploaded                  }
  FileDir:       str20; { Upload/Download Directory                           }
  Count:         byte;  { a count of the # of up/dnloads (for error trapping) }
  CountStr:      str3;  { Counter converted to a string                       }
  ScriptFile:    text;  { file variable for script                            }
  TypeOK,
  FileEx:        boolean;

procedure OpenScript;
begin
  TextColor(Cyan);
  write('              Enter 2 character BBS Identifier (Optional):  ');
  TextColor(LightCyan);
  readln(FileName);
  if FileName<>'' then begin
    Delete(FileName,3,12);
      FileN1:=upcase(copy(FileName,1,1));
      FileN2:=upcase(copy(FileName,2,1));
      FileName:='UD'+FileN1+FileN2+'.SEG';
    end;
  if FileName='' then begin
      FileName:='UD.SEG';
    end;
Assign(ScriptFile, FileName);
gotoxy(61,pred(WhereY));
    writeln(FileName);
    rewrite(ScriptFile);
    TextColor(Cyan);
    write('              Enter u/l d/l Directory (omit trailing "\"): ');
    TextColor(LightCyan);
    readln(FileDir);
    if FileDir='' then begin
         FileDir:= '\QM\DL'
         end;
  end;

procedure WriteScript(UpDown: str1);
var UpDownStr: str12;
    TypeOk: boolean;
begin
  TextColor(LightGray);
  write(' (C=Xmodem CRC, Y=PCBv12, O=PCBv14, G=Ymodem-G, <Z>=Zmodem): ');
  repeat
    TextColor(White);
    readln(TransferType);
    if  TransferType='' then begin
        TransferType:= 'z';
        end;
    TypeOk:=(pos(upcase(TransferType),'ZOYCG')<>0);
    if not TypeOk then gotoxy(1,WhereY-1);clreol;
    if not TypeOk then write(#7,'Please Re-enter (C, Y, O, G, or <Z>): ');
    until TypeOk;
  gotoxy(16, WhereY-2);
  TextColor(LightRed);
  write  ('[',upcase(TransferType),']');
  gotoxy(1, WhereY+1);clreol;writeln;
  TextColor(White);
  case upcase(TransferType) of
    'Z': QTransfer:='Z';
    'O': QTransfer:='O';
    'Y': QTransfer:='O';
    'C': QTransfer:='C';
    'G': QTransfer:='G';
    end;
  case UpDown of
    'U': UpDownStr:='UPLOAD';
    'D': UpDownStr:='DOWNLOAD';
    end;
  Count:=succ(Count);
  str(Count,CountStr);
  writeln(ScriptFile,'; ******  ',UpDownStr,' [',Qtransfer,'] ',FileName,'  *****************');
  writeln(ScriptFile);
  writeln(ScriptFile,'WHEN      ; clear any pending WHEN commands');
  writeln(ScriptFile,'TIMEOUT   4 SYNA',CountStr);
  writeln(ScriptFile,'WAITFOR   "Command"');
  writeln(ScriptFile);
  writeln(ScriptFile,'GOTO      SYNC',CountStr);
  writeln(ScriptFile,'SYNA',CountStr,':');
  writeln(ScriptFile,'TIMEOUT   5 SYNB',CountStr);
  writeln(ScriptFile,'SYNB',CountStr,':');
  writeln(ScriptFile,'IF        $OFFLINE END_IT');
  writeln(ScriptFile,'SEND      "^M"');
  writeln(ScriptFile,'WAITFOR   "Command"');
  writeln(ScriptFile);
  writeln(ScriptFile,'SYNC',CountStr,':');
  writeln(ScriptFile,'TIMEOUT   30 NEXT',CountStr); 
    if UpDown='U' then begin
    writeln(ScriptFile,'EXIST     ',FileDir,'\',FileName,'  CONT',CountStr);
    writeln(ScriptFile,'PAUSE     1000');
    writeln(ScriptFile,'ASSIGN    4 $ATTR');
    writeln(ScriptFile,'COLORFG   12');
    writeln(ScriptFile,'NOTE      FROM PCBUD:  ',FileDir,'\',FileName,'  *NOT*  FOUND!');
    writeln(ScriptFile,'COLOR     $4');
    writeln(ScriptFile,'GOTO      NEXT',CountStr);
    writeln(ScriptFile);
    writeln(ScriptFile,'CONT',CountStr,':');
    writeln(ScriptFile,'WHEN      "duplicates" NEXT',CountStr);
    writeln(ScriptFile,'WHEN      "exists"     NEXT',CountStr);
    writeln(ScriptFile,'WHEN      "Keep upload inside" "Y^M"');
    writeln(ScriptFile,'IF        $OFFLINE END_IT');
    writeln(ScriptFile,'SEND      "',UpDown,' ',FileName,' ',upcase(TransferType),'^M"');    
    writeln(ScriptFile,'WAITFOR   "description"');
    writeln(ScriptFile);
    writeln(ScriptFile,'TIMEOUT   30 NEXT',CountStr);
    writeln(ScriptFile,'IF        $OFFLINE END_IT');
    writeln(ScriptFile,'SEND      "',FileDesc,'^M"');
    writeln(ScriptFile,'WHEN      "upload!"    NEXT',CountStr);
    writeln(ScriptFile,'WAITFOR   "Aborts Transfer"');
    writeln(ScriptFile,'PAUSE     7000');
    writeln(ScriptFile,'UPLOAD    ',Qtransfer,' ',FileDir,'\',FileName);
    end;
    if UpDown='D' then begin
    writeln(ScriptFile,'WHEN      "not found" NEXT',CountStr);
    writeln(ScriptFile,'WHEN      "to Abort." DL',CountStr);
    writeln(ScriptFile,'IF        $OFFLINE END_IT');
    writeln(ScriptFile,'SEND      "',UpDown,' ',FileName,' ',upcase(TransferType),'^M"');
    writeln(ScriptFile,'WAITFOR   "Aborts Transfer"');
    writeln(ScriptFile);
    writeln(ScriptFile,'DL',CountStr,':');
    writeln(ScriptFile,'PAUSE     7000');
    writeln(ScriptFile,'DOWNLOAD  ',Qtransfer,' ',FileDir,'\',FileName);
    end;
  writeln(ScriptFile);
  writeln(ScriptFile,'NEXT',CountStr,':');
  writeln(ScriptFile);
  end;

procedure GetAscii(UpDel: Char);
begin
  gotoxy(1,WhereY-1);clreol;
  if UpDel='A' then begin
    TextColor(LightCyan);write(succ(Count),':');TextColor(White);writeln(' ASCII U/L');
    end;
  if UpDel='N' then begin
    TextColor(LightCyan);write(succ(Count),':');TextColor(White);writeln(' ASCII NO-DEL');
    end;
  TextColor(Cyan);
  write  ('Enter ASCII Upload File Name: ');
  TextColor(LightCyan);
  read   (FileName);
  if FileName='' then begin;
    gotoxy(1,WhereY); clreol; gotoxy(1,WhereY-1); clreol;
    end;
  if FileName<>'' then begin
    gotoxy(1,WhereY);clreol;
    gotoxy(20,WhereY-1);
    TextColor(Yellow);
    writeln(FileName);
    writeln;
    TextColor(LightGray);
    Count:=succ(Count);
    str(Count,CountStr);
    writeln(ScriptFile,'; ******  SEND ',FileName,' ASCII *****************');
    writeln(ScriptFile);
    writeln(ScriptFile,'EXIST     ',FileDir,'\',FileName,'  CONT',CountStr);
    writeln(ScriptFile,'PAUSE     1000');
    writeln(ScriptFile,'ASSIGN    4 $ATTR');
    writeln(ScriptFile,'COLORFG   12');
    writeln(ScriptFile,'NOTE      FROM PCBUD:  ',FileDir,'\',FileName,'  *NOT*  FOUND!');
    writeln(ScriptFile,'COLOR     $4');
    writeln(ScriptFile,'GOTO      NEXT',CountStr);
    writeln(ScriptFile);
    writeln(ScriptFile,'CONT',CountStr,':');
    writeln(ScriptFile,'WHEN      ; clear any pending WHEN commands');
    writeln(ScriptFile,'TIMEOUT   4 SYNA',CountStr);
    writeln(ScriptFile,'WAITFOR   "Command"');
    writeln(ScriptFile);
    writeln(ScriptFile,'GOTO      SYNC',CountStr);
    writeln(ScriptFile,'SYNA',CountStr,':');
    writeln(ScriptFile,'TIMEOUT   5 SYNB',CountStr);
    writeln(ScriptFile,'SYNB',CountStr,':');
    writeln(ScriptFile,'IF        $OFFLINE END_IT');
    writeln(ScriptFile,'SEND      "^M"');
    writeln(ScriptFile,'WAITFOR   "Command"');
    writeln(ScriptFile);
    writeln(ScriptFile,'SYNC',CountStr,':');
    writeln(ScriptFile,'TIMEOUT   5 NEXT',CountStr);
    writeln(ScriptFile,'PAUSE     1000');
    writeln(ScriptFile,'SEND      "E^M"');
    writeln(ScriptFile,'WAITFOR   "?"');
    writeln(ScriptFile);
    writeln(ScriptFile,'PAUSE     1200');
    writeln(ScriptFile,'UPLD      A ',FileDir,'\',FileName,' PACECH=NONE PACESPEED=15 EXPAND=ON EOLCH=10');
    writeln(ScriptFile,'TIMEOUT   110 SYND',CountStr);
    writeln(ScriptFile,'SYND',CountStr,':');
    writeln(ScriptFile,'IF        $OFFLINE END_IT');
    writeln(ScriptFile,'SEND      "^M"');
    writeln(ScriptFile,'WAITFOR   ", (SC)? "');
    writeln(ScriptFile);
    writeln(ScriptFile,'SEND      "S^M"');
    writeln(ScriptFile);
    if UpDel='A' then begin
        writeln(ScriptFile,'DOS       "DEL ',FileDir,'\',FileName,'"');
        writeln(ScriptFile);
        end;
    writeln(ScriptFile,'NEXT',CountStr,':');
    writeln(ScriptFile);
    end;
  end;

procedure GetUpload;
var Ypos: byte;
begin
  gotoxy(1,WhereY-1);clreol;
  TextColor(LightCyan);write(succ(Count),':');TextColor(White);writeln(' UPLOAD FILE');
  TextColor(Cyan);
  write('Enter Upload File Name: ');
  TextColor(LightCyan);
  read  (FileName);
  if FileName='' then begin;
    gotoxy(1,WhereY); clreol; gotoxy(1,WhereY-1); clreol;
    end;
  if FileName<>'' then begin
    gotoxy(1,WhereY);clreol;
    TextColor(Yellow);
    gotoxy(20,WhereY-1);
    writeln(FileName);
    TextColor(Green);
    writeln('Enter Upload Description:      (---------------------------------------------)');
    TextColor(LightRed);
    write  ('You must enter a description >  ');
    TextColor(LightGreen);
    read  (FileDesc);
    if FileDesc='' then begin;
      gotoxy(1,WhereY);ClrEol;gotoxy(1,WhereY-1);ClrEol;gotoxy(1,WhereY-1);ClrEol;
      end;
    if FileDesc<>'' then begin
      FileDesc:=Copy(FileDesc, 1, 45);
      gotoxy(1,WhereY);ClrEol;gotoxy(1,WhereY-1);ClrEol;
      gotoxy(33,WhereY-1);TextColor(White);write(': ');TextColor(Green);writeln(FileDesc);
      TextColor(LightGray);
      write('Upload Type');
      WriteScript('U');
      end;
    end;
  end;

procedure GetDownload;
var Ypos: byte;
begin
  gotoxy(1,WhereY-1);clreol;
  TextColor(LightCyan);write(succ(Count),':');TextColor(White);writeln(' DOWNLD FILE');
  TextColor(Cyan);
  write('Enter Download File Name: ');
  TextColor(LightCyan);
  read  (FileName);
  if FileName='' then begin;
     gotoxy(1,WhereY); clreol; gotoxy(1,WhereY-1); clreol;
     end;
  if FileName<>'' then begin
    gotoxy(1,WhereY);clreol;
    gotoxy(20,WhereY-1);
    TextColor(Yellow);
    writeln(FileName);
    TextColor(LightGray);
    write('Download Type');
    WriteScript('D');
    end;
  end;

procedure Hangup;
begin
  gotoxy(1,WhereY-1);clreol;
  TextColor(LightCyan);write(succ(Count),':');TextColor(White);writeln(' LOGOFF  BBS');writeln;
  Count:=succ(Count);
  str(Count,CountStr);
  writeln(ScriptFile,'; ******  LOGOFF SEGMENT  ********************');
  writeln(ScriptFile);
  writeln(ScriptFile,'WHEN      ; clear any pending WHEN commands');
  writeln(ScriptFile,'TIMEOUT   4 SYNA',CountStr);
  writeln(ScriptFile,'WAITFOR   "Command"');
  writeln(ScriptFile);
  writeln(ScriptFile,'GOTO      SYNC',CountStr);
  writeln(ScriptFile,'SYNA',CountStr,':');
  writeln(ScriptFile,'TIMEOUT   15 SYNB',CountStr);
  writeln(ScriptFile,'SYNB',CountStr,':');
  writeln(ScriptFile,'IF        $OFFLINE END_IT');
  writeln(ScriptFile,'SEND      "^M"');
  writeln(ScriptFile,'WAITFOR   "Command"');
  writeln(ScriptFile);
  writeln(ScriptFile,'SYNC',CountStr,':');
  writeln(ScriptFile,'PAUSE     1000');
  writeln(ScriptFile);
  writeln(ScriptFile,'TURNOFF   CAPTURE');
  writeln(ScriptFile,'ASSIGN  4 78');
  writeln(ScriptFile,'ATWRITE 12 18 $4  " ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ "');
  writeln(ScriptFile,'ATWRITE 12 19 $4  " PRESS Esc TO STAY ONLINE WITH $BOARD "');
  writeln(ScriptFile,'ATWRITE 12 20 $4  "       YOU HAVE 10 SECONDS úúúúúúúúúúúúú                   "');
  writeln(ScriptFile,'ATWRITE 12 21 $4  " ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ "');
  writeln(ScriptFile);
  writeln(ScriptFile,'PAUSE     10000');
  writeln(ScriptFile,'SEND      "G^M"');
  writeln(ScriptFile,'HANGUP');
  writeln(ScriptFile);
  end;

begin
  clrscr;
  TextColor(LightGreen);
  writeln(' Qmodem v4.0/PcBoard  u/l d/l SCRIPT                 Script Segment Generator');
  TextColor(LightRed);
  writeln('   Default segment name is  UD.SEG                    For PCBoard  v12 or 14');
  TextColor(White);
  writeln('    Optional format is  UDxx.SEG');
  writeln(' ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;');
  OpenScript;
  if FileName<>'' then begin
    Count:=0;
    gotoxy(1,2);
    TextColor(LightGray);
    writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÒÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÒÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
    write  ('³                                                                              ');
    gotoxy(8,3);
    TextColor(LightCyan);
    write  ('D/L DIR: ',FileDir);
    TextColor(LightGray);
    gotoxy(28,3);
    write  ('º  SCRIPT FUNCTION MENU  º');
    gotoxy(58,3);
    TextColor(LightCyan);
    write('SEGMENT = ',FileName);
    gotoxy( 79,3);
    TextColor(LightGray);
    writeln('³');
    writeln('³       ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÐÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÐÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·       ³');
    writeln('³       º  A = Write ASCII ul segment     N = ASCII u/l  (NO delete)  º PUBLIC³');
    writeln('³       º  U = Write  upload  segment     D = Write download segment  º DOMAIN³');
    writeln('³ PCBUD º  L = Write  logoff  segment     Q = QuitSegment Generator   º  v2.02³');
    writeln('ÔÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍ;');
    window(1,10,80,25);
    gotoxy(1,1);
    repeat
      TextColor(LightRed);
      write('Enter Command: ');TextColor(Green);write('A, N, U, D, L, <Q>: ');
      TextColor(LightGreen);
      read(Kbd, Command);
        if  Command = #13 then
            Command:= 'q';
      TypeOk:=(pos(upcase(Command),'ANUDLQ')<>0);
      if not TypeOk then
        gotoxy(1,WhereY);
      if TypeOk then
      writeln;
      case upcase(Command) of
        'A': GetAscii('A');
        'N': GetAscii('N');
        'U': GetUpload;
        'D': GetDownload;
        'L': Hangup;
        end;
      until upcase(Command) in ['Q','L'];
    writeln(ScriptFile,'END_IT:');
    writeln(ScriptFile,'RETURN');
    close(ScriptFile);
    gotoxy(1,WhereY-1);clreol;writeln;
    writeln('                           Thank you for using PCBUD!');
    end;
  window(1,1,80,25);
  end.