home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRECOM.ZIP / SAMPLE.ZIP / SAMPLE.MOD < prev    next >
Text File  |  1992-10-02  |  7KB  |  230 lines
  1. IMPLEMENTATION MODULE Sample;
  2. FROM Lists IMPORT Element,GenList;
  3. FROM IO IMPORT WrStrRedirect;
  4. FROM FormIO IMPORT WrF,WrF1,WrF2,WrF3,WrF4,WrF5;
  5. FROM Str IMPORT Copy;
  6.  
  7.  
  8. IMPORT SQLPREP;
  9.  
  10.  
  11. (****
  12. EXEC SQL INCLUDE SQLDA;
  13. ***)
  14. (***** included by precompiler *)
  15. FROM SQLDA IMPORT sqlda,sqldaPtr;
  16. FROM SQLCA IMPORT sqlca;
  17. FROM SQLStuff IMPORT AllocSQLDA, DeallocSQLDA,SQLErrorHandler;
  18. CONST
  19. xxProgName = CHR(111) +CHR(65) +CHR(65) +CHR(66) +CHR(65) +CHR(68) +CHR(67) +CHR(67) +
  20.         CHR(69) +CHR(68) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +
  21.         CHR(115) +CHR(97) +CHR(109) +CHR(112) +CHR(108) +CHR(101) +CHR(32) +CHR(32) +
  22.         CHR(106) +CHR(66) +CHR(90) +CHR(73) +CHR(80) +CHR(67) +CHR(75) +CHR(73) +
  23.         CHR(48) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +CHR(32) +CHR(32);
  24. VAR 
  25.   SQLca : sqlca; (* communications area*)
  26.   SQLda : sqldaPtr; (* data area (if needed ) *)
  27.   RC    : CARDINAL;
  28.  
  29.  
  30. VAR
  31.   StaffRec : Staff;
  32.   OrgRec   : Org;
  33.  
  34.  
  35. PROCEDURE CopyDisplay(Line : ARRAY OF CHAR);
  36. (* intercept the WrFx calls an place in the global display line*)
  37. BEGIN
  38.  Copy(DispLine,Line);
  39. END CopyDisplay;
  40.  
  41.  
  42.  
  43. CLASS IMPLEMENTATION Org;
  44.   (******************************************************)
  45.   (*   SQL CURSORS TO SUPPORT THE CLASS                    *)
  46.   (******************************************************)
  47.  
  48. (****
  49.   EXEC SQL DECLARE GetOrgLst CURSOR FOR
  50.     SELECT * FROM ORG;
  51. ***)
  52.  
  53. (****
  54.   EXEC SQL DECLARE GetStaffLst CURSOR FOR
  55.     SELECT * FROM Staff
  56.     WHERE Dept=:DeptNbr;
  57. ***)
  58.  
  59. (****
  60.   EXEC SQL DECLARE GetOrg CURSOR FOR
  61.     SELECT * FROM Org
  62.     WHERE DeptNumb = :DeptNbr;
  63. ***)
  64.  
  65. (****
  66.   EXEC SQL DECLARE GetStats CURSOR FOR
  67.     SELECT AVG(Salary), MIN(Salary),
  68.            MAX(Salary),SUM(Salary)
  69.     FROM Staff
  70.     WHERE Dept = :DeptNbr;
  71. ***)
  72.  
  73.  
  74.   PROCEDURE GetStaffList();
  75.   VAR AStaff : Staff;
  76.   BEGIN
  77. (****
  78.     EXEC SQL OPEN  GetStaffLst;
  79. ***)
  80.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  81.   RC := SQLPREP.SQLAALOC(1,1,1,NIL);
  82.     RC :=SQLPREP.SQLASETV(1,0,500,2,ADR(DeptNbr),NIL,NIL);
  83.  
  84.   RC := SQLPREP.SQLACALL(26,2,1,0,NIL); 
  85.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  86.     IF StaffLst.Initialized()
  87.       THEN StaffLst.Dispose
  88.       ELSE StaffLst.Initialize('');
  89.     END;
  90.     WITH AStaff DO
  91.         SQLca.sqlcode := 0;
  92.         WHILE SQLca.sqlcode = 0 DO
  93. (****
  94.               EXEC SQL FETCH GetStaffLst INTO
  95.                 :ID,:Name :NameNul,:DeptNbr :DeptNul,:Job :JobNul,:Years:YearNul,
  96.             :Salary:SalNul,:Comm:ComNul;
  97. ***)
  98.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  99.   RC := SQLPREP.SQLAALOC(2,7,2,NIL);
  100.     RC :=SQLPREP.SQLASETV(2,0,500,2,ADR(ID),NIL,NIL);
  101.     RC :=SQLPREP.SQLASETV(2,1,461,15,ADR(Name),ADR(NameNul),NIL);
  102.     RC :=SQLPREP.SQLASETV(2,2,501,2,ADR(DeptNbr),ADR(DeptNul),NIL);
  103.     RC :=SQLPREP.SQLASETV(2,3,461,11,ADR(Job),ADR(JobNul),NIL);
  104.     RC :=SQLPREP.SQLASETV(2,4,501,2,ADR(Years),ADR(YearNul),NIL);
  105.     RC :=SQLPREP.SQLASETV(2,5,481,8,ADR(Salary),ADR(SalNul),NIL);
  106.     RC :=SQLPREP.SQLASETV(2,6,481,8,ADR(Comm),ADR(ComNul),NIL);
  107.  
  108.   RC := SQLPREP.SQLACALL(25,2,0,2,NIL); 
  109.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  110.             AStaff.MakeDisplayLine();
  111.                StaffLst.AddElmt(AStaff);
  112.         END;
  113. (****
  114.         EXEC SQL CLOSE GetStaffLst;
  115. ***)
  116.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  117.   RC := SQLPREP.SQLACALL(20,2,0,0,NIL); 
  118.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  119.     END; (* with astaff *)
  120. (****
  121.     EXEC SQL OPEN GetStats;
  122. ***)
  123.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  124.   RC := SQLPREP.SQLAALOC(3,1,3,NIL);
  125.     RC :=SQLPREP.SQLASETV(3,0,500,2,ADR(DeptNbr),NIL,NIL);
  126.  
  127.   RC := SQLPREP.SQLACALL(26,4,3,0,NIL); 
  128.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  129. (****
  130.     EXEC SQL FETCH GetStats INTO
  131.          :AvgSalary,:MinSalary,:MaxSalary,:TotalSalary;
  132. ***)
  133.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  134.   RC := SQLPREP.SQLAALOC(4,4,4,NIL);
  135.     RC :=SQLPREP.SQLASETV(4,0,480,8,ADR(AvgSalary),NIL,NIL);
  136.     RC :=SQLPREP.SQLASETV(4,1,480,8,ADR(MinSalary),NIL,NIL);
  137.     RC :=SQLPREP.SQLASETV(4,2,480,8,ADR(MaxSalary),NIL,NIL);
  138.     RC :=SQLPREP.SQLASETV(4,3,480,8,ADR(TotalSalary),NIL,NIL);
  139.  
  140.   RC := SQLPREP.SQLACALL(25,4,0,4,NIL); 
  141.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  142. (****
  143.     EXEC SQL CLOSE GetStats;
  144. ***)
  145.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  146.   RC := SQLPREP.SQLACALL(20,4,0,0,NIL); 
  147.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  148.  
  149.   END GetStaffList;
  150.  
  151.   PROCEDURE MakeDisplayLine();
  152.  
  153.   BEGIN
  154.     WrF4('%3u  %12s  %12s  %18s',DeptNbr,DeptName,Division,Location  );
  155.     Assign(DispLine);
  156.   END MakeDisplayLine;
  157.  
  158. BEGIN
  159. END Org;  (* end class implementation org *)
  160.  
  161. (* utility to read org table *)
  162.  
  163.   PROCEDURE GetOrgLst(VAR TheList : GenList);
  164.   VAR OrgUnit : Org;
  165.   BEGIN
  166. (****
  167.     EXEC SQL OPEN GetOrgLst;
  168. ***)
  169.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  170.   RC := SQLPREP.SQLACALL(26,1,0,0,NIL); 
  171.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  172.     IF TheList.Initialized()
  173.       THEN TheList.DisposeList;
  174.       ELSE TheList.InitList;
  175.     END;
  176.     SQLca.sqlcode := 0;
  177.     WHILE SQLca.sqlcode = 0 DO
  178.       WITH OrgUnit DO
  179. (****
  180.       EXEC SQL FETCH GetOrgLst INTO
  181.        :DeptNbr,:DeptName,:Manager,:Division,
  182.        :Location;
  183. ***)
  184.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  185.   RC := SQLPREP.SQLAALOC(5,5,5,NIL);
  186.     RC :=SQLPREP.SQLASETV(5,0,500,2,ADR(DeptNbr),NIL,NIL);
  187.     RC :=SQLPREP.SQLASETV(5,1,460,41,ADR(DeptName),NIL,NIL);
  188.     RC :=SQLPREP.SQLASETV(5,2,500,2,ADR(Manager),NIL,NIL);
  189.     RC :=SQLPREP.SQLASETV(5,3,460,31,ADR(Division),NIL,NIL);
  190.     RC :=SQLPREP.SQLASETV(5,4,460,31,ADR(Location),NIL,NIL);
  191.  
  192.   RC := SQLPREP.SQLACALL(25,1,0,5,NIL); 
  193.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  194.       END;
  195.       OrgUnit.MakeDisplayLine();
  196.       TheList.AddItem(OrgUnit);
  197.  
  198.     END;
  199. (****
  200.     EXEC SQL CLOSE getOrgLst;
  201. ***)
  202.   RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)
  203.   RC := SQLPREP.SQLACALL(20,1,0,0,NIL); 
  204.   RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)
  205.   END GetOrgLst;
  206.  
  207.  
  208.  
  209.  
  210. CLASS IMPLEMENTATION Staff;
  211.  
  212.   PROCEDURE MakeDisplayLine();
  213.  
  214.   BEGIN
  215.     WrF5('%12s  %4s  %4u  %8.2r,  %8.2r',Name,Job, Years,Salary,Comm );
  216.     Assign(DispLine);
  217.   END MakeDisplayLine;
  218.  
  219. BEGIN
  220. END Staff;   (* end class implementation staff *)
  221.  
  222.  
  223. (* initialization code*)
  224.  
  225. BEGIN
  226.   WrStrRedirect := CopyDisplay;   (* redirect output to copy display*)
  227. END Sample.
  228.  
  229.  
  230.