| products/Sources/formale Sprachen/Delphi/Elbe 1.0/Sources/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: Sample.pas Sprache: Delphi |
|
||||||
|
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.22 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
