كتب code example

البرنامج التالي يستقبل رقم العميل كمعيار للمدخلات ويقوم بإرجاع الاسم والعنوان كمعيار للنواتج.

* على مر التاريخ فإن آر بي جي كانت لغة عمودية بطبيعتها، برغم أنها ذات نسق وصياغات حرة * مسموح بها تحت ظروف معينة. * الغرض من تعدد الشفرة في السطور يحدده * شفرة حرفية في العمود رقم 6. * ورمز النجمة (*) في العمود السابع يشير إلى سطر تعليقي * مواصفات "F" (ملف) تحدد الملفات وأجهزة i/o الأخرى F ARMstF1 IF E K Disk Rename(ARMST:RARMST) * مواصفات "D" تستخدم في تحديد المتغيرات D pCusNo S 6p 0 D pName S 30a D pAddr1 S 30a D pAddr2 S 30a D pCity S 25a D pState S 2a D pZip S 10a * مواصفات "c" (الحساب) تستخدم للعبارات القابلة للتنفيذ * يتم تحديد المعايير باستخدام plist وparm opcodes C *entry plist C parm pCusNo C parm pName C parm pAddr1 C parm pAddr2 C parm pCity C parm pState C parm pZip * أما أمر "chain" فيستخدم من أجل الوصول العشوائي إلى ملف ذو شفرة C pCusNo chain ARMstF1 * وإذا ما استدل على وجود تدوين ما، انقل الحقول من الملف إلى معايير C if %found C eval pName = ARNm01 C eval pAddr1 = ARAd01 C eval pAddr2 = ARAd02 C eval pCity = ARCy01 C eval pState = ARSt01 C eval pZip = ARZp15 C endif * تستعين لغة آر بي جي بالتحولات "switches". تحول واحد "LR" عادة يرمز إلى "آخر تدوين last record" * LR في الواقع تحدد البرنامج ومساحة بياناته بحيث تكون قابلة للإزالة من الذاكرة. C eval *InLR = *On

يستعين نفس البرنامج بحسابات حرة:

* مواصفات "F" (الملف) تحدد الملفات وأدوات i/o الأخرى FARMstF1 IF E K Disk Rename(ARMST:RARMST) * مواصفات "D" تستخدم في تحديد المتغيرات والمعايير * "النموذج الأصلي prototype" للبرنامج موجود بملف مستقل * بحيث يسمح للبرامج الأخرى باستدعائه /copy cust_pr * يصف "السطح البيني للإجراء" معايير المُدخل D getCustInf PI D pCusNo 6p 0 const D pName 30a D pAddr1 30a D pAddr2 30a D pCity 25a D pState 2a D pZip 10a /free // أمر "chain" يستخدم من أجل الوصول العشوائي للملفات المُشفرة chain pCusNo ARMstF1; // إذا ما استدل على وجود تدوين، انقل الملفات إلى معايير if %found; pName = ARNm01; pAddr1 = ARAd01; pAddr2 = ARAd02; pCity = ARCy01; pState = ARSt01; pZip = ARZp15; endif; // تستعين لغة آر بي جي بالتحولات "switches". تحول واحد "LR" عادة يرمز إلى "آخر تدوين last record" // LR في الواقع تحدد البرنامج ومساحة بياناته بحيث تكون قابلة للإزالة من الذاكرة. *InLR = *On; /end-free

يستعين نفس البرنامج بحسابات حرة: وSQL مدرج

* لا تحتاج لغة آر بي جي فور مرة أخرى الاستعانة بمؤشر *INLR لإنهاء البرنامج. *باستخدام الكلمة الرئيسية الأساسية في العنوان "H"، وتحديد "main" * أو اسم إجراء المُدخل، سيبدأ البرنامج وينتهي بشكل معتاد باستخدام * دورة آر بي جي القديمة منذ عقود وبالتالي سيبدأ البرنامج بشكل أشبه كثيرا بالسي وينتهي منطقيا. H MAIN("GETCUSTINF") * مواصفات "D" تستخدم في تحديد المتغيرات والمعايير * "النموذج الأصلي prototype" للبرنامج موجود بملف مستقل * بحيث يسمح للبرامج الأخرى باستدعائه /copy cust_pr * يصف "السطح البيني للإجراء" معايير المُدخل D getCustInf PI D pCusNo 6p 0 const D pName 30a D pAddr1 30a D pAddr2 30a D pCity 25a D pState 2a D pZip 10a /free exec sql select ARNm01, ARAd01, ARAd02, ARCy01, ARSt01, ARZp15 into :pName, :pAddr1, :pAddr2, :pCity, :pState, :pZip from ARMstF1 where ARNo01 = :pCusNo for fetch only fetch first 1 row only optimize for 1 row with CS; /end-free

• يصف "السطح البيني للإجراء" معايير المُدخل *

D getCustInf PI

D pCusNo 6p 0 const

D pName 30a

D pAddr1 30a

D pAddr2 30a

D pCity 25a

D pState 2a

D pZip 10a

/free

exec sql select ARNm01, ARAd01, ARAd02, ARCy01, ARSt01, ARZp15

into :pName, :pAddr1, :pAddr2, :pCity, :pState, :pZip

from ARMstF1

where ARNo01 = :pCusNo

for fetch only

fetch first 1 row only

optimize for 1 row

with CS;

/end-free

لنفترض أن نموذج الجدول ARMSTF1 صنع باستخدام عبارة SQL التالية:

create table armstf1 (arcnum decimal(7,0), arname char(30), aradd1 char(30), aradd2 char(30), arcity char(25), arstte char(2), arzip char(10))

وبالنسبة لنظام تشغيل V7R1، فإن البرنامج السابق يمكن كتابته (بشكل صحيح وكامل) كالآتي:

H main(GetCustInf) D ARMSTF1 E DS P GetCustInf B D GetCustInf PI extpgm("CUS001") D inCusNo like(arCNum) const D outName like(arName) D outAddr1 like(arAdd1) D outAddr2 like(arAdd2) D outCity like(arCity) D outState like(arStte) D outZip like(arZip) /free exec sql select arName, arAdd1, arAdd2, arCity, arStte, arZip into :outName, :outAddr1, :outAddr2, :outCity, :outState, :outZip from ARMSTF1 where arCNum = :inCusNo fetch first 1 row only with CS use currently committed; /end-free P GetCustInf E