|
unit Sample;
//-------------------------------------------------------
//
//....
//
//
//-------------------------------------------------------
interface
uses
//-------------------------------------------------------
//
//-------------------------------------------------------
GenDefs,OwnUtils,Language,Utilities,OptionClass,
//-------------------------------------------------------
//
//-------------------------------------------------------
Forms,StdCtrls,Controls,Classes;
//-------------------------------------------------------
//
//-------------------------------------------------------
const
Indent=' ';
type
progtypes=(LeereDatei,Konsolprog,Unterprog,Copy,Dateiprog,SQLProg,CICSProg,
DLIProg,OOProg);
TSamples= class(TForm)
ComboBox1:TComboBox;
Label1:TLabel;
Button1:TButton;
Button2:TButton;
procedure Button1Click(Sender:TObject);
procedure FormShow(Sender:TObject);
procedure FormCreate(Sender:TObject);
procedure Button2Click(Sender:TObject);
procedure ComboBox1Key(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
Outfil:TextFile;
NewFilNam:JString;
NewFilDir:JString;
NewFilExt:JString;
Language:(c,cob,java);
changed:boolean;
Signatures: array [progtypes] of JString;
end;
//-------------------------------------------------------
//
//-------------------------------------------------------
implementation
{$R *.dfm}
uses
//-------------------------------------------------------
//specific
//-------------------------------------------------------
Windows,Messages,SysUtils,Variants,Graphics,Dialogs;
//-------------------------------------------------------
//
//-------------------------------------------------------
procedure TSamples.Button1Click(Sender:TObject);
var
tmpl:integer;
procedure P(S:JString);
begin
if Language=c then
writeln(Outfil,S)
else begin
if opt.R.Sourceformat=FreeFormat then
writeln(Outfil,S)
else
writeln(Outfil,Indent+S);
end;
end;
Procedure Emptyprogram;
begin
P('');
end;
Procedure AcceptProgramm;
begin
if Language=cob then begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Data Division.');
P(' Working-Storage Section.');
P(' 77 n pic 9(4).');
P(' Procedure Division.');
P('* dies ist ein Muster');
P(' Accept n');
P(' Display n.');
P(' End-Program Template.');
end
else if Language=c then begin
P(' int main() {');
P(' int n;');
P(' scanf("%i",n);');
P(' printf("%i\n",n);}');
end
else if Language=java then begin
P('import java.util.Scanner;');
P(' ');
P('public class InputExp {');
P(' ');
P(' public static void main(String[] args) {');
P(' ');
P(' String name;');
P(' int age;');
P(' Scanner in = new Scanner(System.in);');
P(' ');
P(' // Liest einen String von der Konsole ');
P(' name = in.nextLine();');
P(' ');
P(' // Liest eine Zahl von der Konsole ');
P(' age=in.nextInt();');
P(' in.close();');
P(' ');
P(' System.out.println("Name :"+name);');
P(' System.out.println("Age :"+age);');
P(' ');
P(' }}');
end;
end;
Procedure Subprogram;
begin
if Language=cob then begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Data Division.');
P(' Working-Storage Section.');
P(' 77 n pic 9(4).');
P(' Linkage Section.');
P(' 77 x pic 9(4).');
P(' 77 y pic 9(4).');
P(' 77 r pic 9(4).');
P(' Procedure Division using x, y returning r.');
P('* dies ist ein Muster');
P(' Add x, y giving n');
P(' Move n to r.');
P(' End-Program Template.');
end
else if Language=c then begin
P(' int main(int x, int y) {');
P(' return x+y;}');
end;
end;
Procedure Copybook;
begin
if Language=cob then begin
P(' 77 n pic 9(4).');
P(' 77 x pic 9(4).');
P(' 77 y pic 9(4).');
P(' 77 r pic 9(4).');
end
else if Language=c then begin
P(' #define a "abc"');
P(' int n;');
P(' float x;');
end;
end;
Procedure FileProgramm;
begin
if Language=cob then begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Environment Division.');
P(' Input-Output section.');
P(' File-Control.');
P(' Select file1 assign to "file1.txt"');
P(' Organization is Sequential');
P(' Status is file-status.');
P(' Data Division.');
P(' File Section.');
P(' FD file1');
P(' record contains 120 characters');
P(' data record is record1.');
P(' 01 record1 pic x(120).');
P(' Working-Storage Section.');
P(' 01 file-status pic 9(4).');
P(' 88 ok-file1 value zero.');
P(' 77 n pic 9(4).');
P(' Procedure Division.');
P('* dies ist ein Muster');
P(' Move Zero to n');
P(' Open input file1');
P(' Perform until not ok-file1');
P(' Read file1');
P(' Add 1 to n');
P(' End-Perform.');
P(' Close file1.');
P(' Display n " Sätze gelesen".');
P(' End-Program Template.');
end
else if Language=c then begin
P(' int main() {');
P(' FILE f;int n;char c;');
P(' n=0;');
P(' f=fopen("myfile.txt","r");');
P(' if (f!=0) {');
P(' while (!EOF(f)) {');
P(' getc(f,c); ');
P(' n++;}} ');
P(' printf("%i zeichen gelesen\n",n);}');
end
else if Language=java then begin
P('import java.io.*;');
P(' ');
P('public class readstrings {');
P(' public void add() {');
P(' try { ');
P(' BufferedReader in = new BufferedReader(new FileReader("infilename"));');
P(' String str;');
P(' while ((str = in.readLine()) != null) { ');
P(' process(str);}');
P(' in.close();}');
P(' catch (IOException e) {}');
P(' }}');
end;
end;
Procedure SQLProgramm;
begin
if Language=cob then begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Data Division.');
P(' Working-Storage Section.');
P(' 77 temp-empno pic 9(8).');
P(' 77 temp-empname pic X(32).');
P(' EXEC SQL INCLUDE SQLCA END-EXEC.');
P(' Procedure Division.');
P('* dies ist ein Muster');
P(' move 1 to temp-empno.');
P(' perform until sqlcode not=0');
P(' exec sql');
P(' select field');
P(' into :temp-empname');
P(' from stl.sysadm.emp');
P(' where empno=:temp-empno');
P(' end-exec');
P(' if sqlcode=0 then');
P(' display "no "temp-empno"''s name is "temp-empname');
P(' add 1 to temp-empno');
P(' end-perform.');
P(' display "End at "temp-empno.');
P(' End-Program Template.');
end
else if Language=java then begin
P('// Query1.java: Query an mSQL database using JDBC.');
P(' ');
P('import java.sql.*;');
P(' ');
P('class Query1 {');
P(' ');
P(' public static void main (String[] args) {');
P(' try {');
P(' String url = "jdbc:msql://127.0.0.1:3306/DB";');
P(' Connection conn = DriverManager.getConnection(url,"","");');
P(' Statement stmt = conn.createStatement();');
P(' ResultSet rs;');
P(' ');
P(' rs = stmt.executeQuery("SELECT Name FROM Kunden");');
P(' while ( rs.next() ) {');
P(' String last = rs.getString("Name");');
P(' System.out.println(last);}');
P(' conn.close();}');
P(' catch (Exception e) {');
P(' System.err.println(e.getMessage());');
P(' }}}');
end;
end;
Procedure CICSProgramm;
begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Data Division.');
P(' Working-Storage Section.');
P(' 77 n pic 9(4).');
P(' linkage section.');
P(' 77 DFHEIBLK pic 9(4).');
P(' 77 DFHCOMMAREA pic 9(4).');
P(' PROCEDURE DIVISION USING DFHEIBLK DFHCOMMAREA.');
P('* dies ist ein Muster');
P(' EXEC CICS');
P(' ADDRESS COMMAREA(DFHCOMMAREA)');
P(' END-EXEC.');
P('* CICS Kommandos einsetzen');
P(' EXEC CICS');
P(' RETURN');
P(' END-EXEC');
P(' End-Program Template.');
end;
Procedure DLIProgramm;
begin
P(' Identification Division.');
P(' Program-Id. Template.');
P(' Data Division.');
P(' Working-Storage Section.');
P(' 77 n pic 9(4).');
P(' Procedure Division.');
P('* dies ist ein Muster');
P(' EXEC DLI');
P(' RETURN');
P(' END-EXEC');
P(' End-Program Template.');
end;
procedure OOProgramm();
begin
if Language=cob then begin
P('*International Technical Support Organization');
P('*IBM VisualAge for COBOL for OS/2');
P('*Object-Oriented Programming');
P('*January 1996');
P('*SG24-4606-00');
P('*Appendix A. Example One Source Code');
P('*A.1 Example One - UserInterface Class Code');
P(' IDENTIFICATION DIVISION.');
P(' CLASS-ID. UserInterface Inherits SOMObject.');
P(' ENVIRONMENT DIVISION.');
P(' Configuration Section.');
P(' Repository.');
P(' CLASS SOMObject IS "SOMObject"');
P(' CLASS UserInterface IS "UserInt" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 01 User-action Pic X(10).');
P(' 88 User-add Value ''Addbott'' .');
P(' 88 User-delete Value ''Deletebott'' .');
P(' 88 User-end Value ''End'' .');
P(' 01 User-Bottle Pic X(20).');
P(' PROCEDURE DIVISION.');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. ''ReadInput'' .');
P(' DATA DIVISION.');
P(' Linkage Section.');
P(' 01 Action Pic X(10).');
P(' 01 Bottle Pic X(20).');
P(' PROCEDURE DIVISION Using Bottle Action.');
P(' Display "Enter the action : add, delete, end"');
P(' Accept action from SYSIN');
P(' Move Function Upper-case(action) to Action');
P(' Evaluate action');
P(' When "ADD"');
P(' Set User-add to TRUE');
P(' Perform Get-item');
P(' When "DELETE"');
P(' Set User-delete to TRUE');
P(' Perform Get-item');
P(' When "END"');
P(' Set User-end to TRUE');
P(' End-evaluate');
P(' Move User-action to action');
P(' Exit Method.');
P(' Get-item.');
P(' Display "Enter the item"');
P(' Accept Bottle from SYSIN');
P(' Move Bottle to User-Bottle.');
P(' END METHOD "ReadInput" .');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "WriteMessage" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P('* Copyright IBM Corp. 1996 185');
P(' 01 action Pic X(10).');
P(' 01 bottle Pic X(20).');
P(' Linkage Section.');
P(' 01 Flag Pic 9.');
P(' PROCEDURE DIVISION Using Flag.');
P(' Move user-Action to Action');
P(' Move user-Bottle to Bottle');
P(' IF flag = 0');
P(' Display action " successfully completed on " bottle');
P(' ELSE');
P(' Display action " unsuccessfully completed on " bottle');
P(' END-IF.');
P(' Exit Method.');
P(' END METHOD "WriteMessage" .');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "Writeoutput" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 77 Formatted-cost Pic $Z,ZZZ,ZZ9.99.');
P(' Linkage Section.');
P(' 01 Total-cost Pic 9(7)V99.');
P(' 01 Case-number Pic 9(5).');
P(' PROCEDURE DIVISION Using Total-cost Case-number.');
P(' Move total-cost to Formatted-cost');
P(' Display "Your order costs " Formatted-cost');
P(' Display "Your case number is " Case-number');
P(' Exit Method.');
P(' END METHOD "Writeoutput" .');
P(' END CLASS UserInterface.');
P('* A.2 Example One - WineCase Class Code');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' CLASS-ID. Winecase Inherits SOMObject.');
P(' ENVIRONMENT DIVISION.');
P(' Configuration Section.');
P(' Repository.');
P(' CLASS SOMObject IS "SOMObject"');
P(' CLASS Winecase IS "Winecase" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 01 Case-Number Pic 9(5).');
P(' 01 Case-date Pic X(8).');
P(' 01 Case-Count Pic 99.');
P(' 01 Case-Contents.');
P(' 05 Case-Entry occurs 12 times.');
P(' 10 Case-Bottle Pic X(20).');
P(' PROCEDURE DIVISION.');
P('***');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "somDefaultInit" OVERRIDE.');
P(' PROCEDURE DIVISION.');
P(' Compute Case-number = Function Random (99999)');
P(' Move "01011996" to Case-date');
P(' Move 0 to Case-count');
P('* 186 IBM VA for COBOL OO Programming');
P('* Initialize Case-Contents.');
P(' Exit Method.');
P(' END METHOD "somDefaultInit" .');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "AddBott" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 77 sub Pic 99 VALUE 0.');
P(' 01 Found-Flag Pic 9.');
P(' 88 found VALUE 0.');
P(' 88 not-found VALUE 1.');
P(' Linkage Section.');
P(' 01 In-bottle Pic X(20).');
P(' 01 Add-flag Pic 9.');
P(' PROCEDURE DIVISION USING In-bottle Add-flag.');
P(' Set not-found to True');
P(' Move 1 to Add-flag');
P(' Perform varying sub from 1 by 1');
P(' until (sub > 12) or (found)');
P(' IF Case-Bottle(sub) = SPACES');
P(' Move in-bottle to Case-Bottle(sub)');
P(' Add 1 to Case-Count');
P(' Move 0 to Add-flag');
P(' Set found to TRUE');
P(' END-IF');
P(' End-Perform.');
P(' Exit method.');
P(' END METHOD "AddBott" .');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "RemoveBott" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 77 sub Pic 99 VALUE 0.');
P(' 01 Found-Flag Pic 9.');
P(' 88 found VALUE 0.');
P(' 88 not-found VALUE 1.');
P(' Linkage Section.');
P(' 01 Out-bottle Pic X(20).');
P(' 01 Delete-flag Pic 9.');
P(' PROCEDURE DIVISION USING Out-bottle Delete-flag.');
P(' Set not-found to True');
P(' Move 1 to Delete-flag');
P(' Perform varying sub from 1 by 1');
P(' until (sub > 12) or (found)');
P(' IF Case-Bottle(sub) = Out-bottle');
P(' Move SPACES to Case-Bottle(sub)');
P(' Subtract 1 from Case-Count');
P(' Move 0 to Delete-flag');
P(' Set found to TRUE');
P(' END-IF');
P(' End-Perform.');
P(' Exit method.');
P(' END METHOD "RemoveBott" .');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "CalculateCost" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P('* Appendix A. Example One Source Code 187');
P(' 77 sub Pic 99 VALUE 0.');
P(' 77 cost Pic 9(5)V99.');
P(' Linkage Section.');
P(' 01 Total-cost Pic 9(7)V99.');
P(' PROCEDURE DIVISION using Total-cost.');
P(' Move 0 to Total-cost');
P(' Perform varying sub from 1 by 1');
P(' until sub > case-count');
P(' ADD 1 to Total-cost');
P(' End-Perform.');
P(' Exit method.');
P(' END METHOD "CalculateCost" .');
P('**');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "GetCaseNumber" .');
P(' DATA DIVISION.');
P(' Linkage Section.');
P(' 01 Case-num Pic 9(5).');
P(' PROCEDURE DIVISION using Case-num.');
P(' Move Case-number to Case-num.');
P(' Exit method.');
P(' END METHOD "GetCaseNumber" .');
P('*');
P(' IDENTIFICATION DIVISION.');
P(' METHOD-ID. "DescribeCase" .');
P(' ENVIRONMENT DIVISION.');
P(' Input-Output Section.');
P(' File-Control.');
P(' SELECT case-file ASSIGN to CaseData');
P(' File Status is Data-key');
P(' Organization is Line Sequential.');
P(' DATA DIVISION.');
P(' File Section.');
P(' FD case-file External');
P(' Record contains 255.');
P(' 01 case-record Pic X(255).');
P(' Working-Storage Section.');
P(' 01 Data-key Pic X(2).');
P(' 01 print-line.');
P(' 05 print-case-number Pic 9(5).');
P(' 05 print-case-date Pic X(8).');
P(' 05 print-case-count Pic 99.');
P(' 05 print-case-contents.');
P(' 10 print-case-entry occurs 12 times.');
P(' 15 print-case-bottle Pic X(20).');
P(' PROCEDURE DIVISION.');
P(' Open Output case-file');
P(' Move case-number to print-case-number.');
P(' Move case-date to print-case-date.');
P(' Move case-count to print-case-count.');
P(' Move case-contents to print-case-contents.');
P(' Write case-record FROM print-line.');
P(' Close case-file.');
P(' Exit method.');
P(' END METHOD "DescribeCase" .');
P(' END CLASS Winecase.');
P('*');
P('* Example One - Wine Client Class Code');
P(' IDENTIFICATION DIVISION.');
P(' PROGRAM-ID. Wine.');
P(' ENVIRONMENT DIVISION.');
P(' Configuration Section.');
P(' Repository.');
P(' CLASS SOMObject IS "SOMObject"');
P(' CLASS Case IS "Winecase"');
P(' CLASS UserInterface IS "UserInt" .');
P(' DATA DIVISION.');
P(' Working-Storage Section.');
P(' 77 caseObj Usage Object Reference Case.');
P(' 77 userObj Usage Object Reference UserInterface.');
P(' 77 Case-number Pic 9(5).');
P(' 77 total-cost Pic 9(7)V99.');
P(' 77 action Pic X(10).');
P(' 77 bottle Pic X(20).');
P(' 77 flag Pic X.');
P(' PROCEDURE DIVISION.');
P(' Invoke UserInterface "somNew" RETURNING userObj');
P('* Invoke Case "somNew" RETURNING caseObj ??????????????');
P(' Invoke userobj "ReadInput" Using bottle action');
P(' Perform until action = "End"');
P(' IF action(1:3) = "Add"');
P(' Invoke caseObj "AddBott" Using bottle flag');
P(' ELSE');
P(' Invoke caseObj "RemoveBott" Using bottle flag');
P(' END-IF');
P(' Invoke userObj "WriteMessage" Using flag');
P(' Invoke userObj "ReadInput" Using bottle action');
P(' End-Perform');
P(' Invoke caseObj "CalculateCost" using total-cost');
P(' Invoke caseObj "GetCaseNumber" Using case-number');
P(' Invoke userObj "WriteOutput" Using total-cost case-number');
P(' Invoke caseObj "DescribeCase"');
P(' Invoke caseObj "somFree"');
P(' Invoke userObj "somFree"');
P(' STOP RUN.');
P(' END PROGRAM Wine.');
end
else if Language=java then begin
P('package algebra;');
P('import java.io.*;');
P(' ');
P('public class adder(int adddend) {');
P(' int c=0;');
P(' ');
P(' public void add() {');
P(' int c+=adddend;}');
P('}');
end;
end;
begin
tmpl:=0;
NewFilExt:=ExtractFileExt(opt.R.infile);
if LowerCase(NewFilExt)='.rtf' then
NewFilExt:='.txt';
if not fileexists(opt.R.infile) then
NewFilDir:=ExtractFileDir(opt.R.ProgramDir)
else
NewFilDir:=ExtractFileDir(opt.R.infile);
NewFilNam:=NewFilDir+'\'+'template'+inttostr(tmpl)
+NewFilExt;
while fileexists(NewFilNam) do begin
tmpl:=tmpl+1;
NewFilNam:=NewFilDir+'\'+'template'+inttostr(tmpl)
+NewFilExt;
end;
AssignFile(Outfil,NewFilNam);
rewrite(Outfil);
if ComboBox1.Text=Signatures[LeereDatei] then
Emptyprogram
else if ComboBox1.Text=Signatures[Konsolprog] then
AcceptProgramm
else if ComboBox1.Text=Signatures[Unterprog] then
Subprogram
else if ComboBox1.Text=Signatures[Copy] then
Copybook
else if ComboBox1.Text=Signatures[Dateiprog] then
FileProgramm
else if ComboBox1.Text=Signatures[SQLProg] then
SQLProgramm
else if ComboBox1.Text=Signatures[CICSProg] then
CICSProgramm
else if ComboBox1.Text=Signatures[DLIProg] then
DLIProgramm
else if ComboBox1.Text=Signatures[OOProg] then
OOProgramm
else
AcceptProgramm;
CloseFile(Outfil);
changed:=true;
Close
end;
//-------------------------------------------------------
//
//-------------------------------------------------------
procedure TSamples.Button2Click(Sender:TObject);
begin
Close
end;
//-------------------------------------------------------
// beware of input
//-------------------------------------------------------
procedure TSamples.ComboBox1Key(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Key:=0;
ComboBox1.Text:=Signatures[LeereDatei];
end;
//-------------------------------------------------------
//
//-------------------------------------------------------
procedure TSamples.FormCreate(Sender:TObject);
begin
ComboBox1.Items.Clear;
Language:=cob;
Signatures[LeereDatei]:='leere Datei';
Signatures[Konsolprog]:='Konsolprogramm';
Signatures[Unterprog]:='Unterprogramm';
Signatures[Copy]:='Copy';
Signatures[Dateiprog]:='Dateiprogramm';
Signatures[SQLProg]:='SQL-Programm';
Signatures[CICSProg]:='CICS-Programm';
Signatures[DLIProg]:='DLI-Programm';
Signatures[OOProg]:='objektorientiertes Programm';
end;
//-------------------------------------------------------
//
//-------------------------------------------------------
procedure TSamples.FormShow(Sender:TObject);
var
Ext:JString;
begin
ComboBox1.Items.Clear;
ComboBox1.Items.add(Signatures[LeereDatei]);
ComboBox1.ItemIndex:=0;
changed:=false;
Ext:=LowerCase(ExtractFileExt(opt.R.infile));
if Ext='.c' then begin
Language:=c;
ComboBox1.Items.add(Signatures[Konsolprog]);
ComboBox1.Items.add(Signatures[Dateiprog]);
ComboBox1.ItemIndex:=0;
end
else if Ext='.java' then begin
Language:=java;
ComboBox1.Items.add(Signatures[Konsolprog]);
ComboBox1.Items.add(Signatures[Dateiprog]);
ComboBox1.Items.add(Signatures[SQLProg]);
ComboBox1.ItemIndex:=0;
end
else if (Ext='.cob')or(Ext='.cbl') then begin
Language:=cob;
ComboBox1.Items.add(Signatures[Konsolprog]);
ComboBox1.Items.add(Signatures[Unterprog]);
ComboBox1.Items.add(Signatures[Copy]);
ComboBox1.Items.add(Signatures[Dateiprog]);
ComboBox1.Items.add(Signatures[SQLProg]);
ComboBox1.Items.add(Signatures[CICSProg]);
ComboBox1.Items.add(Signatures[DLIProg]);
ComboBox1.Items.add(Signatures[OOProg]);
ComboBox1.ItemIndex:=0;
end;
end;
end.
[ Dauer der Verarbeitung: 0.7 Sekunden
(vorverarbeitet)
]
|
