home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / mailpro.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  12.1 KB  |  412 lines
  1. {
  2. The easiest method to compile this program,
  3. is to place all source files in one hard  disk  subdirectory  and  compile
  4. using Make - F9. This will compile all units first, then the main EXE file.
  5.  
  6. BE SURE to set Var-string checking to Relaxed in the Options/Compiler menu.
  7.  
  8. }
  9. {$R-}    {Range checking off}
  10. {$B+}    {Boolean complete evaluation on}
  11. {$S+}    {Stack checking on}
  12. {$I+}    {I/O checking on}
  13. {$N-}    {No numeric coprocessor}
  14. {$M 65500,65500,655360} {Turbo 3 default stack and heap}
  15.  
  16. program mailpro (input,output);
  17.  
  18. uses
  19. BL,       CE,       CF,       Colors,   CO,       DEF,      DL,       DQ,
  20. DR,       ED,       ER,       FD,       FF,       FR,       FT,       MF,
  21. MO,       NS,       PG,       PR,       RE,       RET,      SM,       SO,
  22. SS,       IT,
  23. Crt,      ColorDef, DrawSqar, FastWr,   CPaU,     GetForU,  StrnU,    UCasU,
  24. SetBU,    CursorOU, GetKeU,   SetAttU,  BeeU,     ShadoU,   ColorIU,  GenMenus,
  25. TestFile;
  26.  
  27. (*
  28. BldList,                 BL
  29. CheckEnd,                CE
  30. ClrForm,                 CF
  31. Colors;                  CL
  32. Codes,                   CO
  33. CreditDisplay,           IT
  34. MP1Def,                  DEF
  35. DsplyLin,                DL
  36. DelQuery,                DQ
  37. Drive,                   DR
  38. Editor,                  ED
  39. EditRec,                 ER
  40. FileDumU,                FD
  41. FindFone,                FF
  42. Forms,                   FR
  43. FileTops,                FT
  44. GetState,                GS
  45. MP1Files,                MF
  46. Modes,                   MO
  47. NameSrch,                NS
  48. Printing,                PG
  49. Printers,                PR
  50. Records,                 RE
  51. Return,                  RET
  52. SysMenu,                 SM
  53. Sorts,                   SO
  54. ScrnShow,                SS
  55.  
  56. *)
  57.  
  58. procedure ShiftUp;
  59. var Place:         integer;
  60. begin
  61. gotoxy(1,1);                     delline;
  62. gotoxy(1,succ(DisplayLines));    insline;
  63. inc(FirstDisplay);
  64. CheckEnds(FirstDisplay,LastDisplay);
  65. Place := LastDisplay - FirstDisplay + 1;
  66. gotoxy(1,Place);
  67. GetRec(Entry,LastDisplay);
  68. DisplayLine(Entry,Place, Displays.Attr);
  69. end;
  70.  
  71. procedure ShiftDown;
  72. var Place:          integer;
  73. begin
  74. if FirstDisplay <> 1 then
  75.    begin
  76.    gotoxy(1,succ(DisplayLines));     delline;
  77.    gotoxy(1,1);                      insline;
  78.    dec(FirstDisplay);
  79.    CheckEnds(FirstDisplay,LastDisplay);
  80.    gotoxy(1,1);
  81.    GetRec(Entry,FirstDisplay);
  82.    DisplayLine(Entry, 1, Displays.Attr);
  83.    end;
  84. end;
  85.  
  86. (* this procedure initializes the data disk !!! *)
  87. procedure MailStart;
  88. var Answer:     line;
  89.     RecordNum,
  90.     AllowControl,
  91.     I,
  92.     J:          integer;
  93.     AllowInput: boolean;
  94. begin
  95. AllowControl := -1;
  96. AllowInput := true;
  97. DriveSet;
  98. SetBG;
  99. clrscr;
  100. DrawSquare( 1, 1, 80, 5, Msgs.Attr, true);
  101. FastWrite( CPad('You are about to erase any data on drive '+ DataDrive+'.  If that is your',78), 2, 2, Msgs.Attr);
  102. FastWrite( CPad('intent then type "START" and hit [ENTER].',78), 3, 2, Msgs.Attr);
  103. FastWrite( CPad('To exit, strike [ENTER].',78), 4, 2, Msgs.Attr);
  104. Answer := GetForm( 37, 7, 10, Strng(10,#32), 'ABORT', AllowControl, AllowInput,
  105.                    (Inputs.Attr or $0008), [#31..#126]);
  106. clrscr;
  107. if UCase(Answer) = 'START' then
  108.    begin
  109.    Blank := ' ';
  110.    SortTop := 0;        FileTop := 0;
  111.    PutFileTop;
  112.    for I := 1 to MostPrinters do
  113.        begin
  114.        Compress1[I] := 0;      Compress2[I] := 0;
  115.        DeCompress1[I] := 0;    DeCompress2[I] := 0;
  116.        Printers[I] := ' ';
  117.        end;
  118.    PutPrinterCodes;
  119.    PutPrinters;
  120.    for RecordNum := 0 to DivisionTop do
  121.        for J := 0 to SubDivisionTop do
  122.            AlphaCode[RecordNum,J] := Blank;
  123.    PutAlphaCodes;
  124.    ShowMode := 1;          PrinterMode := 1;
  125.    ActivePrinter := 1;       ProgramUse := 1;     ActiveForm := 0;
  126.    PutMode(ShowMode,PrinterMode);
  127.    if not TestFileExist('forms') then
  128.      begin
  129.      for I := 1 to MaxForms do ClearForm(Form[I]);
  130.      WriteForms;
  131.      end;
  132.    MainFileStart;                         (* found at beginning of program *)
  133.    end;                                   (* if..then *)
  134. end;
  135.  
  136.  
  137. (* -------------------------------------------------------------------- *)
  138.  
  139. procedure EditData;
  140. var Temp,
  141.     Continue:       boolean;
  142.     Row:            integer;
  143.     TempEntry:     MainRecordType;
  144.     AltAttr:            byte;
  145.  
  146.   procedure CentralControl(var Continue: boolean);
  147.   var ActionTaken,
  148.       SortContinue,
  149.       FunctionKey:        boolean;
  150.       SortDifference,
  151.       I:              integer;
  152.       X:              string;
  153.   begin
  154.   RecordNum := ( pred(FirstDisplay) + Row );
  155.   FastWrite('Entry    ', 25, 21, Msgs.Attr);
  156.   str(RecordNum,X);  X := X + ' ';
  157.   FastWrite( X, 25, 30, (Msgs.Attr xor $0008));
  158.   CursorOn(false);
  159.   GetKey(Ch,FunctionKey);
  160.   I := ord(Ch);
  161.   DisplayLine( TempEntry, Row, Displays.Attr);
  162.   if FunctionKey then
  163.      begin
  164.      if I=72 then dec(Row);                                 (* uparr *)
  165.      if I=80 then inc(Row);                                 (* dnarr *)
  166.      if I=73 then                                                 (* pg up *)
  167.         begin
  168.         FirstDisplay := FirstDisplay + succ(DisplayLines);
  169.         ScreenDisplay(FirstDisplay,LastDisplay);
  170.         end;
  171.      if I=81 then                                                 (* pg dn *)
  172.         begin
  173.         FirstDisplay := FirstDisplay - succ(DisplayLines);
  174.         ScreenDisplay(FirstDisplay,LastDisplay);
  175.         end;
  176.      if I=71 then Row := 1;                                       (* home *)
  177.      if I=79 then Row := succ(DisplayLines);                      (* end *)
  178.      if Row > succ(DisplayLines) then Row := succ(DisplayLines);
  179.      if Row < 1 then Row := 1;
  180.      if I=59 then ShiftUp;                                         (* f1 *)
  181.      if I=60 then ShiftDown;                                       (* f2 *)
  182.      if Row > (LastDisplay-FirstDisplay+1) then
  183.         Row := LastDisplay - FirstDisplay + 1;
  184.      if I=61 then                                                 (* f3 *)
  185.         begin
  186.         FileDump;
  187.         ScreenDisplay(FirstDisplay,LastDisplay);
  188.         end;
  189.      if I=62 then                                                 (* f4=edit *)
  190.         begin
  191.         EditRecord(RecordNum);
  192.         ScreenDisplay(FirstDisplay,LastDisplay);
  193.         end;
  194.      if I=63 then                                                 (* f5=mode *)
  195.         begin
  196.         ModeMenu;
  197.         TextAttr := Displays.Attr;
  198.         clrscr;
  199.         PutMode(ShowMode,PrinterMode);
  200.         AltAttr := SetAttr( Displays.Blink, false, Displays.BG, Displays.FG);
  201.         ScreenDisplay(FirstDisplay,LastDisplay);
  202.         end;
  203.      if I=64 then                                                 (* f6=Phone *)
  204.         begin
  205.         FindPhone;
  206.         ScreenDisplay(FirstDisplay,LastDisplay);
  207.         end;
  208.      if I=65 then                                                 (* f7=record *)
  209.         begin
  210.         assign(OutPutDevice,'PRN');
  211.         rewrite(OutPutDevice);
  212.         PrintRecord(1,RecordNum);
  213.         close(OutPutDevice);
  214.         end;
  215.      if I=66 then                                                 (* f8=label *)
  216.         begin
  217.         assign(OutPutDevice,'PRN');
  218.         rewrite(OutPutDevice);
  219.         PrintLabel(1,RecordNum);
  220.         close(OutPutDevice);
  221.         end;
  222.      if I=67 then                                                 (* f9=list *)
  223.         begin
  224.         BuildList;
  225.         AltAttr := SetAttr(Displays.Blink,false,Displays.BG,Displays.FG);
  226.         ScreenDisplay(FirstDisplay,LastDisplay);
  227.         end;
  228.      if I=68 then                                                 (* f10=name *)
  229.         begin
  230.         NameSearch;
  231.         Row:=1; LastDisplay := FirstDisplay+DisplayLines; Continue := true;
  232.         ScreenDisplay(FirstDisplay,LastDisplay);
  233.         end;
  234.      if I=82 then
  235.         begin
  236.         NewDataInput;                                           (* insert *)
  237.         SortQuery(SortContinue);
  238.         if SortContinue then
  239.            begin
  240.            SortDifference := FileTop - SortTop;
  241.            if SortDifference > 0 then
  242.               if SortDifference > MaxSortDiff then
  243.                  MergeSort
  244.                 else
  245.                  InsertSort;
  246.            end;
  247.         Continue := true;
  248.         ScreenDisplay(FirstDisplay,LastDisplay);
  249.         end;
  250.      if I=83 then                                                 (* delete *)
  251.         begin
  252.         DeleteQuery(ActionTaken,RecordNum);
  253.         ScreenDisplay(FirstDisplay,LastDisplay);
  254.         end;
  255.      if I=32 then                                                 (* delete *)
  256.         begin
  257.         DeleteQuery(ActionTaken,RecordNum);
  258.         ScreenDisplay(FirstDisplay,LastDisplay);
  259.         end;
  260.      Continue := true;
  261.      end
  262.   else
  263.      begin
  264.      if I=16 then
  265.         begin
  266.         PrintQuery;
  267.         ScreenDisplay(FirstDisplay,LastDisplay);
  268.         end;
  269.      if I=18 then
  270.         begin
  271.         GetRec(ReturnAddress,RecordNum);
  272.         WriteReturn;
  273.         Beep(2);
  274.         end;
  275.      if I = 27 then Continue := false else Continue := true;
  276.      end;
  277.   RecordNum := ( pred(FirstDisplay) + Row );
  278.   GetRec(TempEntry,RecordNum);
  279.   DisplayLine( TempEntry, Row, AltAttr);
  280.   end;
  281.  
  282.   (* -------------------------------------------------------------------- *)
  283.  
  284. begin
  285. NameSearch;
  286. Row:=1;
  287. LastDisplay := FirstDisplay + DisplayLines;
  288. Continue := true;
  289. AltAttr := SetAttr( Displays.Blink, false, Displays.BG, Displays.FG);
  290. RecordNum := ( pred(FirstDisplay) + Row );
  291. GetRec(TempEntry,RecordNum);
  292. DisplayLine( TempEntry, Row, AltAttr);
  293. ScreenDisplay(FirstDisplay,LastDisplay);
  294. while Continue do begin
  295.    if SortTop < 1 then Continue := false;
  296.    if Continue then
  297.       begin
  298.       RecordNum := ( pred(FirstDisplay) + Row );
  299.       GetRec(TempEntry,RecordNum);
  300.       DisplayLine( TempEntry, Row, AltAttr);
  301.       CentralControl(Continue);
  302.       end;  (* if..then *)
  303.    end;     (* while *)
  304. end;
  305.  
  306. (* -------------------------------------------------------------------- *)
  307.  
  308. procedure SetUp;
  309. var Continue,
  310.     SortContinue:       boolean;
  311.     SortDifference:           integer;
  312. begin
  313. GetDrive;
  314. GetMode;
  315. SetFieldLen;
  316. GetAlphaCodes;
  317. GetFileTop;
  318. GetPrinterCodes;
  319. OpenMainFile;
  320. GetPrinters;
  321. ReadForms;
  322. WriteState := false;   (* only used if windows are used *)
  323. ReadReturn;
  324. end;
  325.  
  326. (* -------------------------------------------------------------------- *)
  327.  
  328. procedure Main;
  329. var SortContinue:       boolean;
  330.     SortDifference:     integer;
  331. begin
  332. clrscr;
  333. (* DrawSquare( 1, 1, 80, 25, Displays.Attr, true); *)
  334. Shadow( 25, 10, 55, 15, Msgs.Attr, true);
  335. FastWrite( CPad('Standby !',20), 12, 30, Msgs.Attr);
  336. FastWrite( CPad('Loading files ...',20), 13, 30, (Msgs.Attr or $0080) );
  337. (* loading *)
  338. SetUp;
  339. AlphaCode[0,0] := 'Main Division Menu';
  340. if SortTop < 2 then
  341.    begin
  342.    NewDataInput;
  343.    SortQuery(SortContinue);
  344.    if SortContinue then
  345.       begin
  346.       SortDifference := FileTop - SortTop;
  347.       if SortDifference > 0 then
  348.          if SortDifference > MaxSortDiff then
  349.             MergeSort
  350.            else
  351.             InsertSort;
  352.       end;
  353.    EditData;
  354.    end
  355. else
  356.    EditData;
  357. CloseMainFile;
  358. end;
  359.  
  360. (* -------------------------------------------------------------------- *)
  361.  
  362. procedure MainMenu;
  363. var FunctionKey:       boolean;
  364.     Ch:                char;
  365.     Temp:              LineArray;
  366. begin
  367. Temp[0] := 'Main Menu';
  368. Temp[1] := '1. Run main program';
  369. Temp[2] := '2. Set program colors';
  370. Temp[3] := '3. Set drive designation';
  371. Temp[4] := '4. Initialize data disk';
  372. Temp[5] := '5. Set top of file';
  373. Temp[6] := '9. EXIT program';
  374. while Ch <> #27 do
  375.   begin
  376.   Ch := RetMenu( Temp, 6, FunctionKey);
  377.   case Ch of
  378.      '1':   Main;
  379.      '2':   ColorSet;
  380.      '3':   DriveSet;
  381.      '4':   MailStart;
  382.      '5':   SetTopOfFile;
  383.      '9':   Ch := #27;
  384.      end;   (* case *)
  385.   end;        (* while *)
  386. end;
  387.  
  388. (* -------------------------------------------------------------------- *)
  389.  
  390. (*                            *** Main program ****
  391. *)
  392. begin
  393. clrscr;
  394. Menus.FG := 0;
  395. Menus.BG := 0;
  396. CursorOn(false);
  397. DataDrive := DriveDefault;
  398. Device := 'PRN';
  399. BlankLine := Strng(80, ' ');
  400.  
  401. CreditDisplay;
  402. Delay(5000);
  403.  
  404. GetColors;
  405. TextAttr := Displays.Attr;
  406.  
  407. MainMenu;
  408. CursorOn(true);
  409. clrscr;
  410. end.
  411. 
  412.