بخش 1 : مقدمه
1-1 مقدمه ای بر بانک اطلاعاتی
دادِگان (پایگاه دادهها یا بانک اطلاعاتی) به مجموعهای از اطلاعات با ساختار منظم و سامـانمند گـفته میشود. این پایگاههای اطلاعاتی معمولاً در قالبی که برای دستگاهها و رایانهها قابل خواندن و قابل دسترسـی باشند ذخیــــره میشوند. البته چنین شیوه ذخیرهسازی اطلاعات تنها روش موجود نیست و شیوههـای دیگری مانند ذخیرهســازی ساده در پروندهها نیز استفاده میگردد. مسئلهای که ذخیرهسازی دادههـا در دادگــان را موثر میســازد وجود یک ساختار مفهومی است برای ذخیرهسازی و روابط بین دادههااست.
پایگاه داده در اصل مجموعهای سازمان یافته از اطلاعات است.این واژه از دانش رایانه سرچشمه میگیرد ،اما کاربر وسیع و عمومی نیز دارد، این وسعت به اندازهای است که مرکز اروپایی پایگاه داده (که تعاریف خردمندانهای برای پایگاه داده ایجاد میکند) شامل تعاریف غیر الکترونیکـی برای پایگاه داده میباشـد. در این نوشـتار به کاربرد های تکنیکی برای این اصطلاح محدود میشود.
یک تعریف ممکـن این اسـت کـه: پایگـاه داده مجموعـهای از رکورد هـای ذخیره شـده در رایـانه بـا یک روش سیستماتیک (اصولی) مثل یک برنامه رایانهای است که میتواند به سوالات کاربر پاسخ دهد. برای ذخیره و بازیابی بهتر، هر رکورد معمولا به صـورت مجموعهای از اجـزای دادهای یا رویداد هـا سازماندهـی مـیگردد. بخش های بازیابی شده در هر پرسش به اطلاعاتی تبدیل میشود که برای اتخاذ یک تصمیـم کاربرد دارد. برنامـه رایانهای که برای مدیریت و پرسش و پاسخ بین پایگاههای دادهای استفاده میشود را مدیـر سیستم پایگاه دادهای یا به اختصار (DBMS) مینامیم. خصوصیات و طراحی سیستم های پایگاه دادهای در علم اطلاعات مطالعه میشود.
مفهوم اصلی پایگاه داده این است که پایگاه داده مجموعهای از رکورد ها یا تکه هایی از یک شناخت است.نوعا در یک پایگـاه داده توصیـف ساخـت یافتهای برای موجـودیت هـای نگـه داری شده در پایـگاه داده وجود دارد: این توصیف با یک الگو یا مدل شناخته میشود. مدل توصیفی، اشیا پایگاههای داده و ارتباط بین آنها را نشـان میدهد. روش های متفاوتی برای سازماندهی این مدل ها وجود دارد که به آنها مدل های پایگـاه داده گوییم. پرکاربردترین مدلی که امروزه بسیار استفاده میشود، مدل رابطهای است که به طـور عـام به صورت زیر تعریف میشود: نمایش تمام اطلاعاتی که به فرم جداول مرتبط که هریک از سطـر ها و ستونـها تشکیـل شده است (تعریف حقیقی آن در علم ریاضیات برسی میشود). در این مدل وابستگی ها بـه کمـک مقادیر مشترک در بیش از یک جدول نشان داده میشود. مدل های دیگری مثل مدل سلسلـه مراتب و مدل شبکهای به طور صریح تری ارتباط ها را نشان میدهند.
در مباحث تخصصی تر اصتلاح دادگان یا پایگاه داده به صورت مجموعـهای از رکـورد هـای مرتبط با هم تعریف میشود. بسیاری از حرفهای ها مجموعهای از داده هایی با خصوصیات یکسان به منظـور ایجـاد یک پایگاه دادهای یکتا استفاده میکنند.
معمولا DBMS ها بر اساس مدل هایی که استفاده میکنند تقسیم بنـدی میشونـد: ارتباطی،شی گـرا، شبکـهای و امثال آن. مدل هـای دادهای به تعیین زبانهای دسترسـی بـه پایگاههای داده علاقه مند هستند. بخش قابل توجهی از مهندسـی DBMS مستقـل از مـدل های میباشد و به فـاکتور هایی همچون اجرا، همزمانی،جامعیت و بازیافت از خطاهای سخت افزاری وابسطه است.در این سطح تفاوت های بسیاری بین محصولات وجود دارد.
موارد زیر به صورت خلاصه شرح داده می شود:
2-1 تاریخچه پایگاه داده
3-1 انواع دادگان ها
4-1 مدل های پایگاه داده
1-4-1 مدل تخت
2-4-1 مدل شبکه ای(Network)
3-4-1 مدل رابطه ای
4-4-1 پایگاه دادههای چند بعدی
5-4-1 پایگاه دادههای شیء
5-1 ویژگیهای سیستم مدیریت پایگاه دادهها
6-1 فهرست سیستمهای متداول مدیریت دادگان
2-1 تاریخچه پایگاه داده
اولیـن کاربردهـای اصطـلاح پایـگـاه داده بـه June 1963 بـاز مـیگردد، یعنـی زمـانی کــه شرکـت System Development Corporation مسئولیـت اجـرایـی یـک طـرح به نـام "توسعه و مدیریت محاسباتی یک پایگاه دادهای مرکزی" را بر عهده گرفت. پایگاه داده به عنوان یک واژه واحد در اوایل دهـه 70 در اروپا و در اواخر دهه 70 در خبر نامههای معتبر آمریکایی به کار رفـت.(بانـک دادهای یا Databank در اوایـل سـال 1966 در روزنامه واشنگتن کار رفت).
تصویر:اولین سیستم مدیریت پایگاه داده در دهه 60 گسترش یافت. از پیشگامـان این شاخه چارلز باخمن میباشد. مقالات باخمـن ایـن را نشـان داد که فرضیـات او کاربرد بسیار موثرتری برای دسترسی به وسایل ذخیره سازی را مهیـا میکنـد. در آن زمانهـا پردازش داده بر پایـه کـارت های منگنه و نوار هـای مغناطیسی بود که پردازش سری اطلاعات را مهیا میکند. دو نوع مدل دادهای در آن زمانهـا ایـجاد شـد:CODASYL موجب توسـعه مدل شبکهای شدکه ریشه در نظریات باخـمن داشت و مدل سلسله مراتبی که توسط North American Rockwell ایجاد شد و بعدا با اقباس از آن شرکت IBM محصولIMS را تولید نمود.
مدل رابطـهای توسـط E. F. Codd در سـال 1970 ارائه شد.او مدل های موجود را مـورد انتقاد قرار میداد. برای مدتـی نسبتا طـولانـی این مدل در مجـامع علـمی مـورد تایید بود. اولیـن محصـول موفق برای میکرو کامپیوتر ها dBASE بودکـه برای سیستـم عامـل هـایCP/M و PC-DOS/MS-DOS ساختـه شـد. در جـریان سال 1980 پژوهـش بر روی مـدل توزیع شده (distributed database) و ماشین های دادگانی (database machines) متمرکـز شد، امـا تاثیر کمـی بر بازار گـذاشت. در سال 1990 توجهات به طرف مدل شی گرا(object-oriented databases) جلـب شـد. این مـدل جـهت کنترل دادههـای مرکب لازم بود و به سادگی بر روی پایگاه دادههای خاص، مهندسی داده(شامل مهندسی نرم افزار منابع) و دادههای چند رسانهای کار میکرد.
در سال 2000 نوآوری تـازهای رخ داد و دادگـان اکسامال (XML) به وجـود آمد. هـدف ایـن مـدل از بین بردن تفاوت بین مستندات و داده هـا اسـت و کمـک میکند که منابع اطلاعاتی چه ساخت یافته باشند یا نه در کنار هم قرار گیرند
3-1 انواع دادگان ها
دادگانها از نظر ساختار مفهومی و شیوهای رفتار با دادهها بر دو نوع هستند :
1.دادگان رابطهای
2.دادگان شیگرا
4-1 مدل های پایگاه داده
شگـرد هـای مختلفـی برای مدل های دادهای وجود دارد. بیشتر سیستم های پایگاه دادهای هر چند که طور معمول بیشتر از یک مـدل را مورد حمایت قرار میدهند، حول یک مدل مشخص ایجاد شده اند. برای هر یک از الگوهای های منطقی (logical model) اجـراهای فیزیکی مختلفی قابل پیاده شدن است و سطوح کنترل مختلفی در انطباق فیزیکی برای کاربران محیا میکند. یک انتخـاب مـناسب تـاثیر مـثری بر اجرا دارد.مثـالی از موارد الگوی رابطهای (relational model) است: همـه رویـدادهای مهـم در مـدل رابطـهای امکان ایجاد نمایههایی که دسترسی سریع به سطرها در جدول را میدهد،فراهم میشود.
یک مـدل دادهای تنهـا شیـوه سـاختمان بـندی داده ها نیست بلکه معمولا به صورت مجموعهای از عملیات ها که میتوانـد روی داده هـا اجـرا شـود تعریـف مـیشوند. برای مثـال در مـدل رابطـهای عملیـاتی هـمچون گـزینش (selection)، طرح ریزی (projection) و اتصال (join) تعریف میگردد.
1-4-1 مدل تخت
مدل تخت یا جدولی (flat (or table) model ) تشـکیل شده اسـت از یـک آرایـه دو بعدی با عناصر دادهای که همه اجزای یک ستون به صورت دادههای مشابه فرض میشود و هـمه عناصـر یک سطـر با هم در ارتباط هستند. برای نمونه در ستون هایی که برای نام کـاربـری و رمـز عبور در جـزئی از سیستم های پایگاه دادهای امنیتی مورد استفاده قرار میگیرد هر سطر شـامل رمـز عبـوری اسـت که مخصوص یک کاربر خاص است. ستون های جدول که با آن در ارتباط هستند به صورت داده کاراکتری، اطـلاعات زمانـی، عـدد صـحیح یـا اعداد ممیز شناور تعریف میشوند. این مدل پایه برنامههای محاسباتی(spreadsheet) است.
پایـگاه داده هـا با فایـل هـای تـخت به سـادگی توسط فایل های متنی تعریف میشوند. هر رکورد یک خط است و فیلد ها به کمک جدا کننده هایی از هم مجزا میشوند. فرضا به مثال زیر دقت کنید:
id name team
1 Amy Blues
2 Bob Reds
3 Chuck Blues
4 Dick Blues
5 Ethel Reds
6 Fred Blues
7 Gilly Blues
8 Hank Reds
دادههای هر ستون مشابه هـم اسـت ما بـه این ستونهـا فیلـد ها (fields) گوییم. و هر خط را غیر از خط اول یک رکـورد(record) مـینامیم. خـط اول را که برخـی پـایگاههـای دادهای آنرا ندارند رکورد برچسب(field labels) گوییم. هر مقدار دادهای اندازه خاص خود را دارد که اگـر به آن اندازه نـرسـد مـیتوان از کاراکنر فاصله برای این منظور استفاده کرد اما این مسئله مخصوصا زمانی که بخواهیـم اطلاعـات را بـر روی کـارت های منگنه قرار دهیم مشکل ساز خواهد شد. امروزه معمولا از نویسه TAB برای جـداسـازی فیلـد ها و کـاراکتر خـط بعد برای رکورد بعدی استفاده میکنیم. البته شیوههای دیگری هم وجود دارد مثلا به مثال زیر دقت کنید:
"1","Amy","Blues"
"2","Bob","Reds"
"3","Chuck","Blues"
"4","Dick","Blues"
"5","Ethel","Reds"
"6","Fred","Blues"
"7","Gilly","Blues"
"8","Hank","Reds"
این مثال از جدا کننده کاما استفاده میکند.در این نوع مدل تنها قابلیت حذف،اضافه،دیدن و ویرایش وجود دارد که ممکن است کافی نباشد.Microsoft Excel این مدل را پیاده سازی میکند.
2-4-1 مدل شبکه ای(Network)
در سال 1969 و در کنفرانس زبانهای سیستم هـای دادهای (CODASYL) توسطCharles Bachman ارائه شد. در سال 1971 مجددا مطـرح شـد و اسـاس کار پایگاه دادهای قرار گرفت و در اوایل دهه 80 با ثبت آن درسازمان بین المللی استانداردهای جهانی یا ISO به اوج رسید.
مدل شبکهای (database model) بر پایه دو سازه مهم یعنی مجموعه ها و رکورد ها ساخته میشود و برخلاف روش سلسله مراتبی که از درخت استفاده میکند، گـراف را به کار میگیرد. مزیت این روش بر سلسله مراتبی این است که مدل های ارتباطی طبیعی بیشتری را بین موجـودیت هـا فراهـم میکند. الی رغم این مزیت ها به دو دلیل اساسی این مدل با شکست مواجه شد: اول اینکه شرکت IBM بـا تولید محصـولات IMS و DL/I که بر پایه مدل سلسله مراتبی است این مدل را نادیده گرفت. دوم اینکه سرانجام مدل رابطهای (relational model) جای آن را گرفت چون سطح بالاتر و واضح تر بود. تا اوایل دهـه 80 بـه علـت کـارایی رابـط هـای سطح پایین مدل سلسله مراتبی و شبکهای پیشنهاد میشد که بسیاری از نیاز های آن زمان را برطـرف میکـرد. اما با سـریعتر شـدن سخت افزار به علت قابلیت انعطاف و سودمندی بیشتر سیستم های رابطهای به پیروزی رسیدند.
رکورد ها در این مدل شامل فیلد هایی است (ممکـن اسـت همچـون زبـان کوبول (COBOL) به صورت سلسله مراتب اولویتی باشد). مجموعه ها با ارتباط یـک بـه چنـد بیـن رکورد ها تعریف میشود:یـک مالک و چند عضو عملیات های مدل شبکهای از نوع هدایت کننده است: یک برنامه در موقعیت جـاری خـود باقـی میماند و از یک رکورد به رکورد دیگر میرود هر گاه که ارتباطی بین آنها وجود داشته باشد. معمولا از اشارهگرها(pointers) برای آدرس دهی مستقیم به یک رکورد در دیسک استفاده میشود. با این تکنیـک کارایـی بـازیابی اضـافه مـیشـود هر چند در نمایش ظاهری این مدل ضروری نیست .
3-4-1 مدل رابطه ای
مدل رابطـه ای (relational model) در یـک مقـاله تحصیلـی توسـط E. F. Codd در سـال 1970 ارائه گشت. این مدل یک مدل ریاضیاتی است که با مفاهیمی چون مستندات منطقی (predicate logic) و تئوری مجموعه ها (set theory) در ارتباط اسـت. محصـولاتی همچون اینگرس،اراکل، DB2 وسرور اسکیوال (SQL Server) بر این پایه ایجاد شده است. ساختار داده ها در این محصولات به صورت جدول است با این تفاوت که میتواند چند سطر داشته باشد.به عبـارت دیگر دارای جداول چـند گانه است که به طور صریح ارتباطات بین آنها بیان نمیشود و در عوض کلید هایی به منظور تطبیق سطر ها در جداول مختلف استفاده میشود. به عنوان مثال جدول کارمندان ممکن است ستونی به نام "موقعیت" داشته باشد که کلید جدول موقعیت را با هم تطبیق میدهد.
4-4-1 پایگاه دادههای چند بعدی
پایگاه دادههـای رابطـهای توانسـت به سرعت بازار را تسخیر كند، هرچند كارهایی نیز وجود داشت كه این پایگاه دادهها نمیتوانست به خوبی انجام دهد. به ویژه به كارگیری كلیدها در چند ركورد مرتبط به هم و د ر چند پایگـاه داده مشترك، كندی سیستم را موجب میشد. برای نمونه برای یافتن نشانی كاربری با نام دیویـد، سیستـم رابطهای باید نام وی را در جدول كاربر جستجو كند و كلید اصـلی (primary key ) را بیابد و سپس در جدول نشانـیها، دنبال آن كلید بگردد. اگر چه این وضعیت از نظر كاربر، فقط یـك عملیـات محسوب، امـا به جستجـو درجـداول نیازمند است كه این كار پیچیده و زمان بر خواهد بود. راه كار ایـن مشكـل ایـن اسـت كـه پایگاه دادهها اطلاعات صریح درباره ارتباط بین دادهها را ذخیره نماید. مـیتوان بـه جای یافتن نشانی دیوید با جستجو ی كلید در جدول نشانی، اشارهگر به دادهها را ذخـیره نمـود. در واقـع، اگـر ركـورد اصـلی، مالك داده باشد، در همان مكان فیزیكی ذخیره خواهد شد و از سوی دیگر سرعت دسترسی افزایش خواهد یافت.چنین سیستمـی را پایگـاه دادههـای چند بعدی مینامند. این سیستم در هنگامی كه از مجموعه دادههای بزرگ استفاده میشود، بسیار سودمند خواهد بود. از آنجاییكه این سیستم برای مجموعه دادههای بزرگ به كار میرود،هیچگاه در بازار به طور مستقیم عمومیت خواهد یافت.
5-4-1 پایگاه دادههای شیء
اگر چه سیستمهای چند بعدی نتوانستند بازار را تسخـیر نمـایند، امـا به توسعـه سیستمهای شیء منجر شدند. این سیستمها كه مبتنی بر ساختار و مفاهیم سیستمهای چند بعدی هستند،بـه كاربر امكان میدهـند تـا اشیاء را به طور مستقیـم در پایگـاه دادههـا ذخیـره نمـاید. بدیـن ترتیب سـاختار برنامه نویسی شیء گرا (object oriented ) را میتوان به طور مستقیم و بدون تبدیل نمودن به سایر فرمتها، در پایگاه دادهها مورد استفاده قرار داد. این وضعیت به دلیل مفاهیم مالكیـت (ownership) در سیستـم چند بعدی، رخ میدهد. در برنامه شیء گرا (OO)، یك شیء خاص "مالك " سایر اشیاء در حافظـه اسـت، مثلا دیوید مالك نشانی خود میباشد. در صورتی كه مفهوم مالكیت در پایگاه دادههای رابطهای وجود ندارد.
5-1 ویژگیهای سیستم مدیریت پایگاه دادهها
پس از این مقدمه به توصـیف سیستـ مدیریت پایگاه دادهها میپردازیم. سیستم مدیریت پایگاه دادهها، مـجموعهای پیچیده از برنامههای نرمافزاری است كه ذخیره سازی و بازیابی دادههای (فیلدها، ركوردها و فایلها) سازمان را در پایگاه دادهها، كنترل مـیكند. این سیستم، كنترل امنیت و صحت پایگاه دادهها را نیز بر عهده دارد. سیستم مدیریت پایگاه دادهها، درخواستهـای داده را از برنـامـه مـیپذیرد و به سیستم عامل دستور میدهد تا دادهها ی مناسب را انتقال دهد. هنگامی كه چنین سیستمی مورد استفـاده قـرار میگیرد، اگر نیازمندیهای اطلاعاتی سپازمانی تغییر یابد، سیستـمهای اطلاعاتی نیز آسانتر تغییر خواهند یافت. سیستم مذكور از صحت پایگاه دادهها پشتیبانی میكند . بدین ترتیب كه اجازه نمیدهد بیش از یك كاربر در هر لحظه، یك ركورد را به روز رسانی كند . این سیستم ركوردهای تكراری را در خارج پایگاه دادهها نگاه میدارد. برای مثال ، هیچ دو مشترك با یك شمـاره مشتـری ، نمیتوانند در پایگاه دادهها وارد شوند. این سیستم روشی برای ورود و بـه روز رسـانی تعامـلی پـایگـاه دادههـا فراهم میآورد. یك سیسـتم اطلاعـات كسـب و كـار از موضوعاتی نظیر (مشتریان، كارمندان، فروشندگان و غیره) و فعالیتهایی چون (سفارشات، پرداختها، خریدها و غیره) تشكیـل شـده اـست.
طراحی پایگاه دادهها، فرایند تصمیم گیری درباره نحوه سـازماندهی این دادهها در انواع ركوردها و برقراری ارتباط بیـن ركـوردهاست.سیستـم مـدیریت پـایگاه دادههـا میتواند ساختار دادهها و ارتباط آنها را در سازمان به طور اثر بخش نشان دهد. سه نوع مدل متداول سازمانی عبارتند از: سلسله مراتبی، شبكهای و رابطهای. یك سیستم مدیریت پایگاه دادهها ممكن است یك، دو یا هر سه روش را فراهم آورد. سرورهای پایگاه دادهها ، كامپیوترهایی هستند كه پایگـاه دادههـای واقعـی را نگـاه مـیدارنـد و فقـط سیستـم مدیریــت پایگـاه دادههـا و نرمافزار مربـوطه را اجرا میكنند. معمولا این سرورها رایانههای چند پردازندهای با آرایههای دیسك RAID برای ذخیره سازی میباشند.
6-1 فهرست سیستمهای متداول مدیریت دادگان
معروفترین این نرمافزارهای مدیریت دادگانها میتوان به چند نمونه زیر اشاره کرد:
1.Oracle
2.Microsoft SQL Server
3.MySQL
4.PostregSQL
5.DB2
6.Microsoft Access
که پروژه ای که در ادامـه مـورد بررسـی قرار می گیرد بـا استفـاده از بـانک اطلاعاتـی Microsoft Access تهیه شده است.
بخش 2: معرفی پروژه
1-2 عنوان پروژه:
بانک اطلاعاتی تجهیزات آزمایشگاه کنترل نیروگاه طوس
آزمایشگـاه کنتـرل نیروگـاه طـوس وظـیفه تسـت ،تـعمیـر و نـگهداری از تجهیزات کنترلی بکار رفته در قسمت های مختلـف نیروگـاه طـوس را به عـهده دارد؛ دردوره تعـیرات اساسی واحد های نیروگاه این آزمایشگاه وظیفه بررسی و تنظیم این تجهیزات را بر اسـاس جـزوات مدونی کـه نحـوه تنظیـم هرتجهیز را مشخص نموده است بر عهده دارد.
نحـوه عمـلکرد بدیـن صـورت است که هر دستگاهی دارای کد خاصـی است که تنظیم آن در جزوه دستورالعمل با توجه به کد آن مشخص شده است؛ که فرد باید با توجه به کد دستگاه در جزوه نحوه تنظیم آن را بیابد و مـورد استفاد قرار بدهد. طبیعتاً این روش دستیابی به اطلاعات تجهیزات را در طـی مدت تعمیرات اساسی کـند می کـند
و متعاقباً روند تعمیرات اساسی را با مشکل مواجه می سازد.
هدف از ایجاد بانک اطلاعات تجهیزات تسریع روند دسترسی به اطلاعات هر تجهیز می باشد.
2-2 مفاهیم اولیه بکار رفته در پروژه
1-2-2 تجهیز :
هر دستگاهی که در آزمایشگاه تست وبررسی و تنظیم میشود،یک تجهیز خاص است.
2-2-2 کد Aks :
شماره مشخصه هر تجهیز که با توجه به آن اطلاعات مورد بازیابی قرار می گیرد.
3-2-2 لیست Mkb :
لیستـی کـه در آن تنظیمـات پیـش فرض هـر تجهیز آورده شده است و هر تجهیز با توجـه بـه شمـاره Aks خود دارای ردیف خاصی در لیست می باشد.
بخش3 : تحلیل ساختار بانک اطلاعاتی
در این بخش ساختار بانک اطلاعاتی از جمله : جداول، ارتباط بین آنها،فرمهای بکار رفته ،query های مورد
استفاده و کدهای Visual basic بکار رفته در بانک مورد بررسی قرار می گیرد.
1-3 ساختار جداول:
1-1-3 جدول Grp
این جدول به منظور تعیین رده های تجهیز طراحی شده،از جمله این رده ها می توان از ترانسمیترها،سوئیچها و
نام برد.(شکل1-3)
شکل 1-3
Properties
DateCreated: 2006/10/22 07:19:16 ق.ظ DefaultView: Datasheet
NameMap: Long binary data OrderByOn: False
Orientation: Left-to-Right RecordCount: 5
Updatable: True
Columns
Name Type Size
grpID Long Integer 4
grpname Text 50
Relationships
grpInstrument
grp Instrument
grpID 1 ¥ groupID
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
grpsubgrpname
grp subgrpname
grpID 1 ¥ grp
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
2-1-3 جدول Instrument
از این جدو.ل برای نگهداری مشخصات تجهیز استفاده می شود.(شکل 2-3)
شکل 2-3
Properties
DateCreated: 2006/10/22 07:19:16 ق.ظ DefaultView: Datasheet
NameMap: Long binary data OrderByOn: True
Orientation: Left-to-Right RecordCount: 17
Updatable: True
Columns
Name Type Size
InsID Long Integer 4
groupID Long Integer 4
subgrpID Long Integer 4
Ins_name Text 50
Aks_code Text 50
tech_spcification Memo -
local_code Text 50
existance Long Integer 4
details Anchor -
offering_comp Text 50
filepath Text 250
Relationships
grpInstrument
grp Instrument
grpID 1 ¥ groupID
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
subgrpnameInstrument
subgrpname Instrument
subgrpID 1 ¥ subgrpID
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
3-1-3 جدول List
این جدول حاوی بخشی از اطلاعات لیست Mkb برای هر تجهیز میباشد و هر تجهیز در این جدول دارای ردیف خاصی است.(شکل 3-3)
شکل 3-3
Properties
DateCreated: 2006/10/23 08:34:35 ق.ظ DefaultView: Datasheet
NameMap: Long binary data OrderByOn: False
Orientation: Left-to-Right RecordCount: 2316
Updatable: True
Columns
Name Type Size
ردیف Text 255
نام دستگاه Text 255
مشخصات فنی Text 255
کاربرد Text 255
AKS کد شناسائی Text 255
اندازه گیری باره Text 255
دامنه تنظیم Text 255
نقطه تنظیم Text 255
نوع دستگاه/شرکت سازنده Text 255
4-1-3 جدول 'Sheet1 (ELC
این جدول حاوی بخش دیگر از اطلاعات لیست Mkb برای هر تجهیز میباشد و هر تجهیز در این جدول دارای ردیف خاصی است.(شکل 4-3)
شکل 4-3
Properties
DateCreated: 2006/10/23 12:19:09 ب.ظ DefaultView: Datasheet
NameMap: Long binary data OrderByOn: False
Orientation: Left-to-Right RecordCount: 864
Updatable: True
Columns
Name Type Size
ردیف Double 8
كُد ابزار Text 255
محل كارت Text 255
شماره كارت Text 255
كاربرد كارت Text 255
مقدار ورودی Text 255
سیگنال ورودی Text 255
تریشولد ورودی Text 255
مقدار خروجی Text 255
سیگنال خروجی Text 255
تریشولد خروجی Text 255
5-1-3 جدول Subgrpname
این جدول به منظور تعییـن زیـر رده هـای تجهیـز طراحـی شده و بـرای هـر ردیف در جدول Grp زیر رده های خاصی وجود دارد.(شکل 5-3)
شکل 5-3
Properties
DateCreated: 2006/10/22 07:19:16 ق.ظ DefaultView: Datasheet
NameMap: Long binary data OrderByOn: False
Orientation: Left-to-Right RecordCount: 7
Updatable: True
Columns
Name Type Size
subgrpID Long Integer 4
grp Long Integer 4
subgrpname Text 50
Relationships
subgrpnameInstrument
subgrpname Instrument
subgrpID 1 ¥ subgrpID
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
grpsubgrpname
grp subgrpname
grpID 1 ¥ grp
صفات: Enforced; Cascade Updates; Cascade Deletes
نوع ارتباط: One-To-Many
6-1-3 جدول tblDatabases
این جدول نام و مسیر بانک اطلاعاتی را جهت استفاده ماژول Backup نگهداری می کند.(شکل 6-3)
شکل 6-3
Properties
DateCreated: 2006/10/22 07:19:17 ق.ظ
LastUpdated: 2006/10/22 11:45:16 ق.ظ OrderByOn: False
RecordCount: 14 Updatable: True
Columns
Name Type Size
DBId Long Integer 4
DatabaseName Text 50
FolderPath Text 255
7-1-3 جدول tblObjects
این جدول اطلاعاتی راجع عملیت پشتیبان گیری از جمله اجزایی که عملیات پشتیبان گیری از آنها انجام شده یا
اجزایی که باید از آنها پشتیبان گرفته شود و همچنین تاریخ آخرین عملیات را نگهداری میکند.(شکل 7-3)
شکل 7-3
Properties
DateCreated: 2006/10/22 07:19:17 ق.ظ
LastUpdated: 2006/10/22 11:45:16 ق.ظ OrderByOn: False
RecordCount: 1703 Updatable: True
Columns
Name Type Size
objectID Long Integer 4
DBId Long Integer 4
ObjectType Long Integer 4
ObjectName Text 100
RevisionNumber Integer 2
LastBackupTimeStamp Date/Time 8
BackupRecommended Yes/No 1
LastUpdated Date/Time 8
2-3 نحوه ارتباط بین جداول
شکل 8-3 نحوه ارتباط بین جداول را در بانک اطلاعاتی مشخص می کند.
شکل 8-3
3-3 فرمها
1-3-3 Switchboard
فرم اصلی که به عنوان صفحه کلید بانک عمل می کند.(شکل 9-3)
شکل 9-3
2-3-3 Data Entry
بخش ورود اطلاعات به 3 قسمت تقسیم می شود :
1- اطلاعات تجهیز
2- اطلاعات رده تجهیز
3- اطلاعات زیر رده تجهیز
1-2-3-3 ورود اطلاعات تجهیز
برای ورود و ثبت اطلاعات تجهیز از این فرم استفاده می شود.(شکلهای10-3،11-3،12-3و13-3)
شکل 10-3
شکل 11-3
شکل 12-3
شکل 13-3
2-2-3-3 ورود اطلاعات رده تجهیز
برای ورود و ثبت اطلاعات رده تجهیز از این فرم استفاده می شود.(شکل 14-3)
شکل 14-3
3-2-3-3 ورود اطلاعات زیررده تجهیز
برای ورود و ثبت اطلاعات زیررده تجهیز از این فرم استفاده می شود.(شکل 15-3)
شکل 15-3
3-3-3 گزارشات
1-3-3-3 لیست تجهیزات بر اساس گروه
برای گزارش گیری از تجهیزات موجود بر اساس یک رده خاص از این فرم استفاده میشود.(شکل 16-3)
شکل 16-3
نتیجه گزارش گیری از تجهیزات بر اساس رده (گروه) بصورت زیر نمایش داده میشود.(شکل 17-3)
شکل 17-3
2-3-3-3 لیست تجهیزات بر اساس نام و کد Aks :
از این فرم برای گزارش گیـری از تجهـیزات بر اسـاس تمـام یـا قسمتی از نام یا کد Aks تجهیز استفاده میشود.
(شکل 18-3)
شکل 18-3
نحوه نمایش جزئیات برای یک تجهیز خاص مورد جستجو بصورت زیر خواهد بود.(شکل 19-3)
شکل 19-3
4-3-3 فرم Back up
هنگام اجرا برای اولین بار اطلاع می دهد که تا به حال کاتالوگ اجزا برای این بانک ساخته نشده است و با تائید
کاربر این کاتالوگ ساخته می شود.(شکل 20-3)
شکل 20-3
بعد از این مرحله فرم پشتیبان گیری به شکل زیر ظاهر می گردد.(شکل 21-3)
شکل 21-3
که در آن اجزای که باید از آنها پشتیبان گرفته شود تیک خورده اند.
فایلهای پشتیبان بصورت یک فولدر که شامل چند فایل متنی است در شاخه پیش فرض ذخیره میشوند.
5-3-3 فرم Restore
برای استفـاده از فـایل های پشتیبان در مواقع لزوم کافی Restore tab را در فرم پشتیبان کلیک نموده و وارد
حالت Restore شویم.(شکل22-3)
شکل22-3
در این حالت کافی شی که میخواهیم آنرا بازیابی کنیم انتخاب نموده و گزینه Import را کلیک نماییم تا
شی مورد نظر بازیابی گردد.
4-3 ساختار Query های بکاررفته در گزارشات و فرمها
1-4-3 نام query : elecakssearch
این query با دریافت کد Aks مشخصات تجهیز مورد نظز را در جدول Mkb بر می گرداند.(شکل23-3)
شکل 23-3
SQL
SELECT ['Sheet1 (ELC].ردیف, ['Sheet1 (ELC].[كُد ابزار], ['Sheet1 (ELC].[محل كارت], ['Sheet1 (ELC].[شماره كارت], ['Sheet1 (ELC].[كاربرد
كارت], ['Sheet1 (ELC].[مقدار ورودی], ['Sheet1 (ELC].[سیگنال ورودی], ['Sheet1 (ELC].[تریشولد ورودی], ['Sheet1 (ELC].[مقدار خروجی],
['Sheet1 (ELC].[سیگنال خروجی], ['Sheet1 (ELC].[تریشولد خروجی]
FROM ['Sheet1 (ELC]
WHERE (((['Sheet1 (ELC].[كُد ابزار]) Like Forms!akssearchdetails!Text24));
Query Parameters
Name Type
Forms!akssearchdetails!Text24 Text
Columns
Name Type Size
ردیف Double 8
كُد ابزار Text 255
محل كارت Text 255
شماره كارت Text 255
كاربرد كارت Text 255
مقدار ورودی Text 255
سیگنال ورودی Text 255
تریشولد ورودی Text 255
مقدار خروجی Text 255
سیگنال خروجی Text 255
تریشولد خروجی Text 255
2-4-3 نام query : qry_ins_in_grp
این query برای فیلتر کردن فیلد زیر رده تجهیز با توجه به رده انتخاب شده در فرم ورود اطلاعات تجهیز بکار میرود(.شکل 24-3)
شکل 24-3
SQL
SELECT grp.grpname, subgrpname.subgrpname
FROM grp INNER JOIN subgrpname ON grp.grpID = subgrpname.grp
GROUP BY grp.grpname, subgrpname.subgrpname;
Columns
Name Type Size
grpname Text 50
subgrpname Text 50
3-4-3 نام query : Query1
این Query با توجه به کد aks کـه در فـرم جستجـو بر اسـاس Aks دریافت کـرده لیست تجهیزات را نمایش میدهد.(شکل 25-3)
شکل 25-3
SQL
SELECT Instrument.Ins_name, Instrument.Aks_code, subgrpname.subgrpname, grp.grpname
FROM subgrpname INNER JOIN (grp INNER JOIN Instrument ON grp.grpID=Instrument.groupID) ON
subgrpname.subgrpID=Instrument.subgrpID
WHERE (((Instrument.Aks_code) Like "*" & Forms!name_aks_search!Text0 & "*"))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
Forms!name_aks_search!Text0 Text
Columns
Name Type Size
Ins_name Text 50
Aks_code Text 50
subgrpname Text 50
grpname Text 50
4-4-3 نام query : Query12
این Query با توجـه بـه نـامی کـه در فـرم جستجـو بر اسـاس نـام دریافت کـرده لیسـت تجهیـزات را نمایش میدهد.(شکل 26-3)
شکل 26-3
SQL
SELECT Instrument.Ins_name, Instrument.Aks_code, subgrpname.subgrpname, grp.grpname
FROM subgrpname INNER JOIN (grp INNER JOIN Instrument ON grp.grpID=Instrument.groupID) ON
(subgrpname.subgrpID=Instrument.subgrpID) AND (grp.grpID=subgrpname.grp)
WHERE (((Instrument.Ins_name) Like "*" & Forms!name_aks_search!Text4 & "*"))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
Forms!name_aks_search!Text4 Text
Columns
Name Type Size
Ins_name Text 50
Aks_code Text 50
subgrpname Text 50
grpname Text 50
5-4-3 نام query : Query2
این query با توجه به رده انتخاب شده در فرم جستجـو بر اسـاس گروه ، لیسـت تجهیـزات را فیلتـر مـی کند.
شکل(27-3)
شکل 27-3
SQL
SELECT Instrument.Ins_name, Instrument.Aks_code, grp.grpname, subgrpname.subgrpname, Instrument.tech_spcification,
Instrument.local_code, Instrument.existance, Instrument.details, Instrument.offering_comp
FROM subgrpname INNER JOIN (grp INNER JOIN Instrument ON grp.grpID=Instrument.groupID) ON
(subgrpname.subgrpID=Instrument.subgrpID) AND (grp.grpID=subgrpname.grp)
WHERE (((grp.grpID)=forms!frmgrpsearch!combo0))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
forms!frmgrpsearch!combo0 Text
Columns
Name Type Size
Ins_name Text 50
Aks_code Text 50
grpname Text 50
subgrpname Text 50
tech_spcification Memo N/A
local_code Text 50
existance Long Integer 4
details Replication ID N/A
offering_comp Text 50
6-4-3 نام query : Query3
این query جزئیات تجهیز خاص مورد نظر را از لیست تجهیزاتـی که در گزارش بر اساس یک رده خاص بدست آمده است را با توجه به کد Aks آن فیلتر می کند.(شکل 28-3)
شکل 28-3
SQL
SELECT Instrument.groupID, Instrument.subgrpID, Instrument.Ins_name, Instrument.Aks_code, Instrument.tech_spcification,
Instrument.local_code, Instrument.existance, Instrument.details, Instrument.offering_comp
FROM Instrument
WHERE (((Instrument.Aks_code)=forms!grpsearchresult!text34))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
forms!grpsearchresult!text34 Text
Columns
Name Type Size
groupID Long Integer 4
subgrpID Long Integer 4
Ins_name Text 50
Aks_code Text 50
tech_spcification Memo N/A
local_code Text 50
existance Long Integer 4
details Replication ID N/A
offering_comp Text 50
6-4-3 نام query : Query4
این query جزئیات تجهیز خاص مورد نظر را از لیست تجهیزاتـی که در گزارش بر اساس تمام یا بخشی از کد Aks خاص بدست آمده است را با توجه به کد Aks آن فیلتر می کند.(شکل 29-3)
شکل 29-3
SQL
SELECT Instrument.groupID, Instrument.subgrpID, Instrument.Ins_name, Instrument.Aks_code, Instrument.tech_spcification,
Instrument.local_code, Instrument.existance, Instrument.details, Instrument.offering_comp
FROM Instrument
WHERE (((Instrument.Aks_code)=forms!akssearchresult!text23))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
forms!akssearchresult!text23 Text
Columns
Name Type Size
groupID Long Integer 4
subgrpID Long Integer 4
Ins_name Text 50
Aks_code Text 50
tech_spcification Memo N/A
local_code Text 50
existance Long Integer 4
details Replication ID N/A
offering_comp Text 50
7-4-3 نام query : Query42
این query جزئیات تجهیز خاص مورد نظر را از لیست تجهیزاتـی که در گزارش بر اساس تمام یا بخشی از نام خاص بدست آمده است را با توجه به نام آن فیلتر می کند.(شکل 30-3)
شکل 30-3
SQL
SELECT Instrument.groupID, Instrument.subgrpID, Instrument.Ins_name, Instrument.Aks_code, Instrument.tech_spcification,
Instrument.local_code, Instrument.existance, Instrument.details, Instrument.offering_comp
FROM Instrument
WHERE (((Instrument.Ins_name)=forms!namesearchresult!text23))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
forms!namesearchresult!text23 Text
Columns
Name Type Size
groupID Long Integer 4
subgrpID Long Integer 4
Ins_name Text 50
Aks_code Text 50
tech_spcification Memo N/A
local_code Text 50
existance Long Integer 4
details Replication ID N/A
offering_comp Text 50
8-4-3 نام query : Query43
این query جزئیات تجهیز خاص مورد نظر را از لیست تجهیزاتـی که در گزارش بر اساس تمام یا بخشی از نام خاص بدست آمده است را با توجه به کد Aks آن فیلتر می کند.(شکل 31-3)
شکل 31-3
SQL
SELECT Instrument.groupID, Instrument.subgrpID, Instrument.Ins_name, Instrument.Aks_code, Instrument.tech_spcification,
Instrument.local_code, Instrument.existance, Instrument.details, Instrument.offering_comp
FROM Instrument
WHERE (((Instrument.Aks_code)=forms!namesearchresult!text23))
ORDER BY Instrument.Aks_code;
Query Parameters
Name Type
forms!namesearchresult!text23 Text
Columns
Name Type Size
groupID Long Integer 4
subgrpID Long Integer 4
Ins_name Text 50
Aks_code Text 50
tech_spcification Memo N/A
local_code Text 50
existance Long Integer 4
details Replication ID N/A
offering_comp Text 50
5-3 ساختار ماژول های بکار رفته در بانک اطلاعاتی
Module: basBrowseFiles Page: 1
Properties
Container: Modules DateCreated: 2006/11/06 12:03:26 ب.ظ
LastUpdated: 2006/11/06 12:03:26 ب.ظ Owner: admin
UserName: admin
Code
1 Attribute VB_Name = "basBrowseFiles"
2 Option Compare Database
3 Option Explicit
4
5
6 '.=========================================================================
7 '.Browse Files Module
8 '
9 '
10 '
11 '.=========================================================================
12 ' DO NOT DELETE THE COMMENTS ABOVE. All other comments in this module
13 ' may be deleted from production code, but lines above must remain.
14 '--------------------------------------------------------------------------
15 '.Description : This module calls directly into comdlg32.dll to allow user
16 '. to select a filename using the Windows Common Dialog. The
17 '. user may browse for a file, or enter a file name directly.
18 '.
19 '.
20 '.Rev. History :
21 ' Comments : Normally, to use the Common Dialog you need to physically
22 ' place the ActiveX control onto a form and then use code
23 ' behind the form to implement its functionality. This
24 ' module allows you to incorporate the functionality of the
25 ' File Open/Save part of the Common Dialog without the
26 ' ActiveX control itself. This module is completely self-
27 ' contained. Simply copy it into your database to use it.
28 '.-------------------------------------------------------------------------
29 '.
30 ' ADDITIONAL NOTES:
31 '
32 ' This module only provides the Open/Save file dialog, not the other
33 ' CommonDialog interfaces (ColorChooser, Help, PrintDialog, etc.)
34 '
35 ' If you want your user to browse for folder names (paths) you must use
36 ' the module basBrowseFolders instead.
37 '
38 ' TO STREAMLINE this module for production programs, you should remove:
39 ' 1) Unnecessary comments
40 ' 2) Flag Constants which you do not intend to use.
41 ' 3) The test procedure tsGetFileFromUserTest
42 '
Module: basBrowseFiles Page: 2
43 '--------------------------------------------------------------------------
44 '
45 ' INSTRUCTIONS:
46 '
47 ' ( For a working example, open the Debug window )
48 ' ( and enter tsGetFileFromUserTest. )
49 '
50 '.All the arguments for the function are optional. You may call it with no
51 '.arguments whatsoever and simply assign its return value to a variable of
52 '.the Variant type. For example:
53 '.
54 '. varFileName = tsGetFileFromUser()
55 '.
56 '.The function will return:
57 '. the full path and filename selected or entered by the user, or
58 '. Null if an error occurs or if the user presses Cancel.
59 '.
60 '.Optional arguments may include any of the following:
61 '. rlngFlags : one or more of the tscFN* constants (declared below)
62 '. Combine multiple constants like this:
63 '. tscFNHideReadOnly Or tscFNFileMustExist
64 '. strInitialDir : the directory to display when dialog opens
65 '. strFilter : a string containing any filters you want to use. Each
66 '. part must be separated by the vbNullChar. -example below
67 '. lngFilterIndex: a 1-based index indicating which filter to start with.
68 '. strDefaultExt : Extension to use if user does not enter one.
69 '. strFileName : Default File to display in the File Name text box.
70 '. strDialogTitle: Caption to display in the dialog's title bar.
71 '. fOpenFile : Boolean-True for the Open dialog, False for Save dialog.
72 '
73 ' FILTER EXAMPLE: The filter must be a string containing two parts for each
74 ' filter. The first part is the Description, it is what the user will see
75 ' in the Files of Type box, e.g. "Text Files (*.txt)". The second part is
76 ' the actual filter, e.g. "*.txt". Each part and each filter must be
77 ' separated by the vbNullChar. For example, to provide two filters, one for
78 ' *.mdb files, and one for all files, use a statement like this:
79 '
80 ' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
81 ' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
82 '
83 ' Then pass your strFilter variable as the strFilter argument for the call
84 ' to tsGetFileFromUser()
85 '
86 '.--------------------------------------------------------------------------
87 '.
88
89 Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
90 Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
91
92 Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
93 Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
94
95 Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
96
Module: basBrowseFiles Page: 3
97 Private Type tsFileName
98 lStructSize As Long
99 hwndOwner As Long
100 hInstance As Long
101 strFilter As String
102 strCustomFilter As String
103 nMaxCustFilter As Long
104 nFilterIndex As Long
105 strFile As String
106 nMaxFile As Long
107 strFileTitle As String
108 nMaxFileTitle As Long
109 strInitialDir As String
110 strTitle As String
111 flags As Long
112 nFileOffset As Integer
113 nFileExtension As Integer
114 strDefExt As String
115 lCustData As Long
116 lpfnHook As Long
117 lpTemplateName As String
118 End Type
119
120 ' Flag Constants
121 Public Const tscFNAllowMultiSelect = &H200
122 Public Const tscFNCreatePrompt = &H2000
123 Public Const tscFNExplorer = &H80000
124 Public Const tscFNExtensionDifferent = &H400
125 Public Const tscFNFileMustExist = &H1000
126 Public Const tscFNPathMustExist = &H800
127 Public Const tscFNNoValidate = &H100
128 Public Const tscFNHelpButton = &H10
129 Public Const tscFNHideReadOnly = &H4
130 Public Const tscFNLongNames = &H200000
131 Public Const tscFNNoLongNames = &H40000
132 Public Const tscFNNoChangeDir = &H8
133 Public Const tscFNReadOnly = &H1
134 Public Const tscFNOverwritePrompt = &H2
135 Public Const tscFNShareAware = &H4000
136 Public Const tscFNNoReadOnlyReturn = &H8000
137 Public Const tscFNNoDereferenceLinks = &H100000
138
139 Public Function tsGetFileFromUser( _
140 Optional ByRef rlngflags As Long = 0&, _
141 Optional ByVal strInitialDir As String = "", _
142 Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
143 Optional ByVal lngFilterIndex As Long = 1, _
144 Optional ByVal strDefaultExt As String = "", _
145 Optional ByVal strFileName As String = "", _
146 Optional ByVal strDialogTitle As String = "", _
147 Optional ByVal fOpenFile As Boolean = True) As Variant
148
149 On Error GoTo tsGetFileFromUser_Err
150 Dim tsFN As tsFileName
Module: basBrowseFiles Page: 4
151 Dim strFileTitle As String
152 Dim fResult As Boolean
153
154 ' Allocate string space for the returned strings.
155 strFileName = Left(strFileName & String(256, 0), 256)
156 strFileTitle = String(256, 0)
157
158 ' Set up the data structure before you call the function
159 With tsFN
160 .lStructSize = Len(tsFN)
161 .hwndOwner = Application.hWndAccessApp
162 .strFilter = strFilter
163 .nFilterIndex = lngFilterIndex
164 .strFile = strFileName
165 .nMaxFile = Len(strFileName)
166 .strFileTitle = strFileTitle
167 .nMaxFileTitle = Len(strFileTitle)
168 .strTitle = strDialogTitle
169 .flags = rlngflags
170 .strDefExt = strDefaultExt
171 .strInitialDir = strInitialDir
172 .hInstance = 0
173 .strCustomFilter = String(255, 0)
174 .nMaxCustFilter = 255
175 .lpfnHook = 0
176 End With
177
178 ' Call the function in the windows API
179 If fOpenFile Then
180 fResult = ts_apiGetOpenFileName(tsFN)
181 Else
182 fResult = ts_apiGetSaveFileName(tsFN)
183 End If
184
185 ' If the function call was successful, return the FileName chosen
186 ' by the user. Otherwise return null. Note, the CancelError property
187 ' used by the ActiveX Common Dialog control is not needed. If the
188 ' user presses Cancel, this function will return Null.
189 If fResult Then
190 rlngflags = tsFN.flags
191 tsGetFileFromUser = tsTrimNull(tsFN.strFile)
192 Else
193 tsGetFileFromUser = Null
194 End If
195
196 tsGetFileFromUser_End:
197 On Error GoTo 0
198 Exit Function
199
200 tsGetFileFromUser_Err:
201 Beep
202 MsgBox Err.Description, , "Error: " & Err.Number _
203 & " in function basBrowseFiles.tsGetFileFromUser"
204 Resume tsGetFileFromUser_End
Module: basBrowseFiles Page: 5
205
206 End Function
207
208 ' Trim Nulls from a string returned by an API call.
209
210 Private Function tsTrimNull(ByVal strItem As String) As String
211
212 On Error GoTo tsTrimNull_Err
213 Dim I As Integer
214
215 I = InStr(strItem, vbNullChar)
216 If I > 0 Then
217 tsTrimNull = Left(strItem, I - 1)
218 Else
219 tsTrimNull = strItem
220 End If
221
222 tsTrimNull_End:
223 On Error GoTo 0
224 Exit Function
225
226 tsTrimNull_Err:
227 Beep
228 MsgBox Err.Description, , "Error: " & Err.Number _
229 & " in function basBrowseFiles.tsTrimNull"
230 Resume tsTrimNull_End
231
232 End Function
233
234
Module: cBackupRestore Page: 6
Properties
Container: Modules DateCreated: 2006/10/22 07:19:23 ق.ظ
LastUpdated: 2006/10/22 07:19:23 ق.ظ Owner: admin
UserName: admin
Code
1 VERSION 1.0 CLASS
2 BEGIN
3 MultiUse = -1 'True
4 END
5 Attribute VB_Name = "cBackupRestore"
6 Attribute VB_GlobalNameSpace = False
7 Attribute VB_Creatable = False
8 Attribute VB_PredeclaredId = True
9 Attribute VB_Exposed = False
10 Option Compare Database
11 Option Explicit
12
13 Private mintErrorTrap As Integer
14
15 Private mstrRootFolder As String
16 Private mstrDBName As String
17
18 Private Const mconTABLES = "tables"
19 Private Const mconQUERIES = "queries"
20 Private Const mconFORMS = "forms"
21 Private Const mconREPORTS = "reports"
22 Private Const mconMACROS = "macros"
23 Private Const mconMODULES = "modules"
24 Private Const mconBACKUP_FOLDER = "backups.wzb"
25
26 'Stores complete path to backup folders
27 Private mcolFolders As Collection
28
29 'the files in a specific backup folder
30 Private mcolFiles As Collection
31
32 Public Function GetFileNames(ObjectType As Integer) As String
33 'For a particular object type, return all the backup
34 'files present in a backup folder as a string
35 '
36 On Error GoTo ErrHandler
37 Dim colFiles As Collection
38 Dim strFile As String
39 Dim strFolder As String
40 Dim I As Integer
41 Dim strOut As String
42
43 'First, read the files present in object's backup folder
44 Call sInitCollection(ObjectType)
Module: cBackupRestore Page: 7
45
46 'Now return all the names read previously as formatted
47 'for a two column listbox, first col.=VersionNumber and
48 'SecondColumn=actual FileName w/o the version info
49 strOut = "Version;FileName;"
50 For I = 1 To mcolFiles.Count
51 strFile = mcolFiles.Item(I)
52 If (ObjectType = acTable) Then
53 strOut = strOut _
54 & Mid$(strFile, InStr(strFile, "_") + 1, InStr(strFile, ".") - InStr(strFile, "_") - 1) _
55 & ";" & Left$(strFile, InStr(strFile, "_") - 1) & ";"
56 Else
57 strOut = strOut _
58 & Right$(strFile, Len(strFile) - InStr(strFile, ".")) _
59 & ";" & Left$(strFile, InStr(strFile, ".") - 1) & ";"
60 End If
61 Next
62 strOut = Left$(strOut, Len(strOut) - 1)
63 GetFileNames = strOut
64 ExitHere:
65 Exit Function
66 ErrHandler:
67 GetFileNames = vbNullString
68 Resume ExitHere
69 End Function
70
71 Private Sub sInitCollection(intObjectType As Integer)
72 Dim strFile As String
73 Dim strFolder As String
74
75 'refresh folders collection
76 Call sCheckSubDir(False)
77
78 'Now get the files for this particular index
79 Set mcolFiles = New Collection
80
81 strFolder = mcolFolders(intObjectType & vbNullString) & "\"
82 strFile = Dir(strFolder, vbNormal)
83 Do While Not strFile = vbNullString
84 mcolFiles.Add Item:=strFile, key:=strFile
85 strFile = Dir
86 Loop
87 End Sub
88
89 Public Function ImportObject(ObjectType As Integer, VersionNumber As Integer, FileName As String) As
String
90 On Error GoTo ErrHandler
91 Dim strFilePath As String
92 Dim strNewObjectName As String
93 Dim strImportName As String
94
95 'First read all files for this object
96 Call sInitCollection(ObjectType)
97
Module: cBackupRestore Page: 8
98 'get teh complete path to the object folder being asked for
99 If (ObjectType = acTable) Then
100 strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
101 & FileName & "_" & VersionNumber & ".txt"
102 Else
103 strFilePath = mcolFolders(ObjectType & vbNullString) & "\" _
104 & FileName & "." & VersionNumber
105 End If
106
107 'Make sure we know under what name was the object imported
108 strNewObjectName = Application.Run("acwzmain.wlib_stUniqueDocName", _
109 FileName, ObjectType)
110
111 If Not strNewObjectName = FileName Then
112 strImportName = strNewObjectName
113 Else
114 strImportName = FileName
115 End If
116
117 If (ObjectType = acTable) Then
118 DoCmd.TransferText acImportDelim, , strImportName, strFilePath, True
119 Else
120 Application.LoadFromText ObjectType, _
121 strImportName, _
122 strFilePath
123 End If
124
125 ImportObject = strImportName
126 ExitHere:
127 Exit Function
128 ErrHandler:
129 MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly Or vbCritical
130 ImportObject = vbNullString
131 Resume ExitHere
132 End Function
133
134 Public Sub ExportObjects(rsDynaset As Recordset)
135 'SaveAsText all objects whose names are present
136 'in this recordset and update the revision number
137 '
138 On Error GoTo ErrHandler
139 Dim strDestination As String
140
141 'check for specific object folders underneath mconBACKUP_FOLDER
142 'Create any if need be
143 Call sCheckSubDir(True)
144
145 With rsDynaset
146 Do While Not .EOF
147
148 'Get the folder path
149 If (!ObjectType <> acTable) Then
150 strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
151 & !ObjectName & "." & !RevisionNumber
Module: cBackupRestore Page: 9
152 Else
153 strDestination = mcolFolders(!ObjectType & vbNullString) & "\" _
154 & !ObjectName & "_" & !RevisionNumber & ".txt"
155 End If
156
157 Call SysCmd(acSysCmdSetStatus, "Exporting " & pconQ & !ObjectName & pconQ & "....")
158 If !ObjectType = 0 Then
159 'If it's a table object, use TransferText instead.
160 DoCmd.TransferText acExportDelim, , !ObjectName, strDestination, True
161 Else
162 'Otherwise call the undocumented SaveAsText method
163 Call Application.SaveAsText(!ObjectType, !ObjectName, strDestination)
164 End If
165 'Now increment the RevisionNumber for
166 'the next time around.
167 .Edit
168 !RevisionNumber = !RevisionNumber + 1
169 !BackupRecommended = False
170 !LastBackupTimeStamp = Now()
171 .Update
172 .MoveNext
173 Loop
174 End With
175 ExitHere:
176 On Error Resume Next
177 Call SysCmd(acSysCmdClearStatus)
178 Exit Sub
179 ErrHandler:
180 Err.Raise pconERR_BASE + 4, "cBackupRestore::ExportObjects", _
181 "Specified object does not exist in source database."
182 Resume ExitHere
183 End Sub
184
185 Public Property Let FolderPath(Value As String)
186 'Where do we want to place all the exports?
187 '
188 'If the folder doesn't exist, return an error
189 If Dir(Value, vbDirectory) = vbNullString Then _
190 Err.Raise pconERR_BASE + 1, "cBackupRestore::FolderPath", _
191 "Invalid path specified"
192 mstrRootFolder = Value
193 If Not Right$(mstrRootFolder, 1) = "\" Then _
194 mstrRootFolder = mstrRootFolder & "\"
195 End Property
196
197 Private Sub sCheckSubDir(blnCreateSubFolders As Boolean)
198 On Error GoTo ErrHandler
199 Dim strPath As String
200 strPath = mstrRootFolder & mconBACKUP_FOLDER & "\"
201
202 'If the backup folder (mconBACKUP_FOLDER) doesn't exist
203 'under this folder, create it
204 If Dir(mstrRootFolder & mconBACKUP_FOLDER, vbDirectory) = vbNullString Then
205 If blnCreateSubFolders Then
Module: cBackupRestore Page: 10
206 Call MkDir(mstrRootFolder & mconBACKUP_FOLDER)
207 End If
208 End If
209
210 'If object specific folders don't exist under mconBACKUP_FOLDER
211 'Create them on the fly if needed (blnCreateSubFolders)
212 If Dir(strPath & mconTABLES, vbDirectory) = vbNullString Then
213 If blnCreateSubFolders Then
214 Call MkDir(strPath & mconTABLES)
215 End If
216 End If
217 mcolFolders.Add Item:=strPath & mconTABLES, key:=acTable & vbNullString
218
219 If Dir(strPath & mconQUERIES, vbDirectory) = vbNullString Then
220 If blnCreateSubFolders Then
221 Call MkDir(strPath & mconQUERIES)
222 End If
223 End If
224 mcolFolders.Add Item:=strPath & mconQUERIES, key:=acQuery & vbNullString
225
226 If Dir(strPath & mconFORMS, vbDirectory) = vbNullString Then
227 If blnCreateSubFolders Then
228 Call MkDir(strPath & mconFORMS)
229 End If
230 End If
231 mcolFolders.Add Item:=strPath & mconFORMS, key:=acForm & vbNullString
232
233 If Dir(strPath & mconREPORTS, vbDirectory) = vbNullString Then
234 If blnCreateSubFolders Then
235 Call MkDir(strPath & mconREPORTS)
236 End If
237 End If
238 mcolFolders.Add Item:=strPath & mconREPORTS, key:=acReport & vbNullString
239
240 If Dir(strPath & mconMACROS, vbDirectory) = vbNullString Then
241 If blnCreateSubFolders Then
242 Call MkDir(strPath & mconMACROS)
243 End If
244 End If
245 mcolFolders.Add Item:=strPath & mconMACROS, key:=acMacro & vbNullString
246
247 If Dir(strPath & mconMODULES, vbDirectory) = vbNullString Then
248 If blnCreateSubFolders Then
249 Call MkDir(strPath & mconMODULES)
250 End If
251 End If
252 mcolFolders.Add Item:=strPath & mconMODULES, key:=acModule & vbNullString
253
254 ExitHere:
255 Exit Sub
256 ErrHandler:
257 Err.Raise pconERR_BASE + 2, "cBackupRestore::sCreateSubDirs", _
258 "Error: " & Err.Description & "(" & Err.Number & ")"
259 Resume ExitHere
Module: cBackupRestore Page: 11
260 End Sub
261
262 Private Sub Class_Initialize()
263 mintErrorTrap = Application.GetOption("Error Trapping")
264 Call Application.SetOption("Error Trapping", 2)
265 Set mcolFolders = New Collection
266 End Sub
267
268 Private Sub Class_Terminate()
269 Call Application.SetOption("Error Trapping", mintErrorTrap)
270 Set mcolFolders = Nothing
271 End Sub
272
Module: Converted Macro- mcrdelete Page: 12
Properties
Container: Modules DateCreated: 2006/10/22 07:19:23 ق.ظ
LastUpdated: 2006/10/22 07:19:23 ق.ظ Owner: admin
UserName: admin
Code
1 Attribute VB_Name = "Converted Macro- mcrdelete"
2 Option Compare Database
3
4 '------------------------------------------------------------
5 ' mcrdelete
6 '
7 '------------------------------------------------------------
8 Function mcrdelete()
9 On Error GoTo mcrdelete_Err
10
11 DoCmd.SetWarnings False
12 DoCmd.RunCommand acCmdDeleteRecord
13
14
15 mcrdelete_Exit:
16 Exit Function
17
18 mcrdelete_Err:
19 MsgBox Error$
20 Resume mcrdelete_Exit
21
22 End Function
23
24
Module: Global Code Page: 13
Properties
Container: Modules DateCreated: 2006/10/22 07:19:23 ق.ظ
LastUpdated: 2006/10/22 07:19:23 ق.ظ Owner: admin
UserName: admin
Code
1 Attribute VB_Name = "Global Code"
2 Option Compare Database
3 Option Explicit
4
5 Function IsLoaded(ByVal strFormName As String) As Integer
6 ' Returns True if the specified form is open in Form view or Datasheet view.
7
8 Const conObjStateClosed = 0
9 Const conDesignView = 0
10
11 If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then
12 If Forms(strFormName).CurrentView <> conDesignView Then
13 IsLoaded = True
14 End If
15 End If
16
17 End Function
18
19 Function ShowMenuBar(Optional strSwitchboardTableName As String = "Switchboard Items")
20 Dim strProcName As String
21 Dim Marker As Integer
22
23 On Error GoTo Err_Section
24 strProcName = "ShowMenuBar"
25 Marker = 1
26
27 abs_CreateSwitchboardMenuBar strSwitchboardTableName
28
29 Exit_Section:
30 On Error Resume Next
31 On Error GoTo 0
32 Exit Function
33 Err_Section:
34 Beep
35 MsgBox "Error in " & strProcName & " (" & Marker & "): " & Err.Number & " - " & Err.Description
36 Err.Clear
37 Resume Exit_Section
38 End Function
39 Function GoToOrderHyperlink(strApp As String)
40 Dim strProcName As String
41 Dim Marker As Integer
42
43 On Error GoTo Err_Section
Module: Global Code Page: 14
44 strProcName = "GoToOrderHyperlink"
45 Marker = 1
46
47 Dim s As String
48 Dim strHyperlink As String
49 Dim strAppName As String
50
51 Select Case strApp
52 Case "abs"
53 'pddxxx
54 strAppName = "A Better Switchboard"
55 strHyperlink = "https://www.swreg.org/soft_shop/224/shopscr27.shtml"
56 Case Else
57 End Select
58
59 s = ""
60 s = s & "This menu option will open a browser window to a secure web site where you can order " &
strAppName & " with your credit card. "
61 s = s & vbCrLf & vbCrLf
62 s = s & "Do you wish to continue?"
63 Beep
64 If MsgBox(s, vbYesNo) = vbYes Then
65 Else
66 MsgBox "Action cancelled."
67 GoTo Exit_Section
68 End If
69
70 Application.FollowHyperlink strHyperlink, , True
71
72 Exit_Section:
73 On Error Resume Next
74 On Error GoTo 0
75 Exit Function
76 Err_Section:
77 Beep
78 MsgBox "Error in " & strProcName & " (" & Marker & "): " & Err.Number & " - " & Err.Description
79 Err.Clear
80 Resume Exit_Section
81 End Function
82 Function OpenSBDemo(Optional strSwitchboardFormName As String = "Switchboard Rect Highlight")
83 Dim Marker As Integer
84
85 On Error GoTo Err_Section
86 Marker = 1
87
88 If Screen.ActiveForm.Name <> strSwitchboardFormName Then
89 On Error Resume Next
90 DoCmd.Close acForm, Screen.ActiveForm.Name
91 Err.Clear
92 On Error GoTo Err_Section
93
94 DoCmd.OpenForm strSwitchboardFormName
95 End If
Module: Global Code Page: 15
96
97 Exit_Section:
98 On Error Resume Next
99 On Error GoTo 0
100 Exit Function
101 Err_Section:
102 Beep
103 MsgBox "Error in OpenSBDemo (" & Marker & "): " & Err.Number & " - " & Err.Description
104 Err.Clear
105 Resume Exit_Section
106 End Function
107
108
Module: modMain Page: 16
Properties
Container: Modules DateCreated: 2006/10/22 07:19:23 ق.ظ
LastUpdated: 2006/10/22 07:19:23 ق.ظ Owner: admin
UserName: admin
Code
1 Attribute VB_Name = "modMain"
2 Option Compare Database
3 Option Explicit
4
5 Private Type BROWSEINFO
6 hOwner As Long
7 pidlRoot As Long
8 pszDisplayName As String
9 lpszTitle As String
10 ulFlags As Long
11 lpfn As Long
12 lParam As Long
13 iImage As Long
14 End Type
15
16 Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
17 "SHGetPathFromIDListA" (ByVal pidl As Long, _
18 ByVal pszPath As String) As Long
19
20 Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
21 "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
22 As Long
23
24 Private Const BIF_RETURNONLYFSDIRS = &H1
25
26 Public Const pconQ = """"
27 Public Const pconERR_BASE = vbObjectError + 5000
28
29 Sub sExportObjects(lngID As Long)
30 'Export out all objects to text format
31 'where BackupRecommended = true for a
32 'particular database
33 '
34 On Error GoTo ErrHandler
35 Dim clsBackup As cBackupRestore
36 Dim intRevNo As Integer
37 Dim rsCurr As Recordset
38 Dim dbCurr As Database
39 Dim dbRemote As Database
40 Dim strSQL As String
41 Dim strPath As String
42
43 Set clsBackup = New cBackupRestore
44 Set dbCurr = CodeDb
Module: modMain Page: 17
45 Set dbRemote = CurrentDb
46
47 'We only want the info pertaining to currentDB
48 strSQL = "Select DatabaseName, FolderPath from tblDatabases Where " _
49 & "dbID=" & lngID
50 Set rsCurr = dbCurr.OpenRecordset(strSQL, dbOpenSnapshot)
51 If rsCurr.RecordCount > 0 Then
52 'Get the path where the exports are supposed to be located
53 strPath = rsCurr!FolderPath
54 clsBackup.FolderPath = strPath
55 'Now get a list of all objects for CurrentDB which
56 'are recommended to be backed up
57 strSQL = "Select * from tblObjects where dbID=" & lngID _
58 & " And BackupRecommended=True"
59 Set rsCurr = dbCurr.OpenRecordset(strSQL, dbOpenDynaset)
60 'Export out all objects in this recordset
61 clsBackup.ExportObjects rsCurr
62 End If
63
64 'Reset BackupRecommended for next time around
65 strSQL = "UPDATE tblObjects SET BackupRecommended = False " _
66 & "WHERE (BackupRecommended=True) AND DBId=" & lngID
67
68 dbCurr.Execute strSQL, dbFailOnError
69
70 MsgBox "All selected objects were successfully saved in text format in the folder" _
71 & vbCrLf & pconQ & strPath & pconQ & ".", vbInformation, "Export successful."
72 ExitHere:
73 On Error Resume Next
74 Set rsCurr = Nothing
75 Set dbCurr = Nothing
76 Set dbRemote = Nothing
77 Set clsBackup = Nothing
78 Exit Sub
79 ErrHandler:
80 MsgBox "Error#: " & Err.Number & vbCrLf & Err.Description, vbCritical, "sExportObjects"
81 Resume ExitHere
82 End Sub
83
84 Sub sLogLastUpdateStamp(lngID As Long)
85 'DAO replacement for an Action query since
86 'functions in SQL statement generate an
87 'error from Add-ins
88 '
89 'Read the time all objects in CurrentDB were last updated
90 '
91 On Error GoTo ErrHandler
92 Dim strSQL As String
93 Dim dbCurr As Database
94 Dim rsCurr As Recordset
95
96 Set dbCurr = CodeDb
97 'Which objects we need to look up?
98 strSQL = "Select LastUpdated, ObjectType, ObjectName From " _
Module: modMain Page: 18
99 & "tblObjects Where DBID = " & lngID
100 Set rsCurr = dbCurr.OpenRecordset(strSQL, dbOpenDynaset)
101 With rsCurr
102 If .RecordCount > 0 Then
103 Do While Not .EOF
104 .Edit
105 'Get the LastUpdated stamp from the container
106 !LastUpdated = fGetLastUpdateStamp(!ObjectType, _
107 !ObjectName)
108 .Update
109 .MoveNext
110 Loop
111 End If
112 End With
113
114 ExitHere:
115 Set rsCurr = Nothing
116 Set dbCurr = Nothing
117 Exit Sub
118 ErrHandler:
119 MsgBox Err.Description & " (" & Err.Number & ")", vbCritical, "sLogLastUpdateStamp"
120 Resume ExitHere
121 End Sub
122
123 Sub sDetermineExportList(lngID As Long)
124 'DAO replacement for an Action query since
125 'functions in SQL statement generate an
126 'error from Add-ins
127 '
128 'Once we have the LastUpdated time for all objects
129 ' in the container, figure out which ones to
130 ' recommend to be backed up.
131 '
132 On Error GoTo ErrHandler
133 Dim strSQL As String
134 Dim dbCurr As Database
135 Dim rsCurr As Recordset
136
137 Set dbCurr = CodeDb
138 strSQL = "Select BackupRecommended, Lastupdated, DBID, LastBackupTimeStamp " _
139 & " From tblObjects Where DBID = " & lngID
140 Set rsCurr = dbCurr.OpenRecordset(strSQL, dbOpenDynaset)
141 With rsCurr
142 If .RecordCount > 0 Then
143 Do While Not .EOF
144 'only if the object has been modified since the
145 'last time we backed it up.
146 If !LastUpdated > Nz(!LastBackupTimeStamp) Then
147 .Edit
148 !BackupRecommended = True
149 .Update
150 End If
151 .MoveNext
152 Loop
Module: modMain Page: 19
153 End If
154 End With
155
156 ExitHere:
157 Set rsCurr = Nothing
158 Set dbCurr = Nothing
159 Exit Sub
160 ErrHandler:
161 MsgBox Err.Description & " (" & Err.Number & ")", vbCritical, "sDetermineExportList"
162 Resume ExitHere
163 End Sub
164
165 Function fGetLastUpdateStamp(intObjectType As Integer, strObjectName As String) As Variant
166 'Returns the LastUpdated property value of a database object
167 '
168 On Error GoTo ErrHandler
169 Dim db As Database
170 Dim datOut As Date
171
172 Set db = CurrentDb
173
174 Select Case intObjectType
175 Case acTable:
176 datOut = db.TableDefs(strObjectName).LastUpdated
177 Case acQuery:
178 datOut = db.QueryDefs(strObjectName).LastUpdated
179 Case acForm:
180 datOut = db.Containers("Forms").Documents(strObjectName).LastUpdated
181 Case acReport:
182 datOut = db.Containers("Reports").Documents(strObjectName).LastUpdated
183 Case acMacro:
184 datOut = db.Containers("Scripts").Documents(strObjectName).LastUpdated
185 Case acModule:
186 datOut = db.Containers("Modules").Documents(strObjectName).LastUpdated
187 End Select
188 fGetLastUpdateStamp = datOut
189 ExitHere:
190 Set db = Nothing
191 Exit Function
192 ErrHandler:
193 fGetLastUpdateStamp = Null
194 Resume ExitHere
195 End Function
196
197 Function fCreateCatalog(strDBName As String, strDBPath As String) As Boolean
198 'Create a new entry in tblDatabases for the CurrentDB
199 'and get a list of all objects from CurrentDB into tblObjects
200 '
201 On Error GoTo ErrHandler
202 Dim db As Database
203 Dim tdfRemote As TableDef
204 Dim qdfRemote As QueryDef
205 Dim docRemote As Document
206 Dim ctrRemote As Container
Module: modMain Page: 20
207 Dim dbRemote As Database
208 Dim rs As Recordset
209 Dim rsObj As Recordset
210 Dim lngID As Long
211
212 Set db = CodeDb
213 Set dbRemote = CurrentDb
214 Set rs = db.OpenRecordset("tblDatabases", dbOpenDynaset)
215 Set rsObj = db.OpenRecordset("tblObjects", dbOpenDynaset)
216 'Add the new database name
217 With rs
218 .AddNew
219 !DatabaseName = strDBName
220 !FolderPath = strDBPath
221 .Update
222 .Bookmark = .LastModified
223 'Which ID got assigned to it?
224 lngID = !DBId
225 End With
226
227 'All the tables
228 Call SysCmd(acSysCmdInitMeter, "Cataloging all tables...", dbRemote.TableDefs.Count)
229 For Each tdfRemote In dbRemote.TableDefs
230 'Don't read system or temp/deleted tables
231 If (tdfRemote.Attributes And dbSystemObject) = False _
232 And Not Left$(tdfRemote.Name, 1) = "~" Then
233 With rsObj
234 .AddNew
235 !DBId = lngID
236 !ObjectType = acTable
237 !ObjectName = tdfRemote.Name
238 .Update
239 End With
240 End If
241 Call SysCmd(acSysCmdUpdateMeter, 1)
242 Next
243
244 'All the queryDefs
245 Call SysCmd(acSysCmdInitMeter, "Cataloging all queries...", dbRemote.QueryDefs.Count)
246 For Each qdfRemote In dbRemote.QueryDefs
247 'Don't read temp/deleted queries
248 If Not Left$(qdfRemote.Name, 1) = "~" Then
249 With rsObj
250 .AddNew
251 !DBId = lngID
252 !ObjectType = acQuery
253 !ObjectName = qdfRemote.Name
254 .Update
255 End With
256 End If
257 Call SysCmd(acSysCmdUpdateMeter, 1)
258 Next
259
260 'All Forms
Module: modMain Page: 21
261 Set ctrRemote = dbRemote.Containers("Forms")
262 Call SysCmd(acSysCmdInitMeter, "Cataloging all forms...", ctrRemote.Documents.Count)
263 For Each docRemote In ctrRemote.Documents
264 'Don't read temp/deleted forms
265 If Not Left$(docRemote.Name, 1) = "~" Then
266 With rsObj
267 .AddNew
268 !DBId = lngID
269 !ObjectType = acForm
270 !ObjectName = docRemote.Name
271 .Update
272 End With
273 End If
274 Call SysCmd(acSysCmdUpdateMeter, 1)
275 Next
276
277 'All Reports
278 Set ctrRemote = dbRemote.Containers("Reports")
279 Call SysCmd(acSysCmdInitMeter, "Cataloging all reports...", ctrRemote.Documents.Count)
280 For Each docRemote In ctrRemote.Documents
281 'Don't read temp/deleted Reports
282 If Not Left$(docRemote.Name, 1) = "~" Then
283 With rsObj
284 .AddNew
285 !DBId = lngID
286 !ObjectType = acReport
287 !ObjectName = docRemote.Name
288 .Update
289 End With
290 End If
291 Call SysCmd(acSysCmdUpdateMeter, 1)
292 Next
293
294 'All Macros
295 Set ctrRemote = dbRemote.Containers("Scripts")
296 Call SysCmd(acSysCmdInitMeter, "Cataloging all macros...", ctrRemote.Documents.Count)
297 For Each docRemote In ctrRemote.Documents
298 'Don't read temp/deleted Macros
299 If Not Left$(docRemote.Name, 1) = "~" Then
300 With rsObj
301 .AddNew
302 !DBId = lngID
303 !ObjectType = acMacro
304 !ObjectName = docRemote.Name
305 .Update
306 End With
307 End If
308 Call SysCmd(acSysCmdUpdateMeter, 1)
309 Next
310
311 'All Modules
312 Set ctrRemote = dbRemote.Containers("Modules")
313 Call SysCmd(acSysCmdInitMeter, "Cataloging all modules...", ctrRemote.Documents.Count)
314 For Each docRemote In ctrRemote.Documents
Module: modMain Page: 22
315 'Don't read temp/deleted Modules
316 If Not Left$(docRemote.Name, 1) = "~" Then
317 With rsObj
318 .AddNew
319 !DBId = lngID
320 !ObjectType = acModule
321 !ObjectName = docRemote.Name
322 .Update
323 End With
324 End If
325 Call SysCmd(acSysCmdUpdateMeter, 1)
326 Next
327 fCreateCatalog = True
328 ExitHere:
329 On Error Resume Next
330 Set rs = Nothing
331 Set rsObj = Nothing
332 Set docRemote = Nothing
333 Set ctrRemote = Nothing
334 Set qdfRemote = Nothing
335 Set tdfRemote = Nothing
336 Set dbRemote = Nothing
337 Set db = Nothing
338 Call SysCmd(acSysCmdRemoveMeter)
339 Call SysCmd(acSysCmdClearStatus)
340 Exit Function
341 ErrHandler:
342 fCreateCatalog = False
343 Resume ExitHere
344 End Function
345
346 Public Function BrowseFolder(szDialogTitle As String) As String
347 'Bring up the BrowseFolder dialog so that
348 'the user may select a new location for all backups
349 '
350 Dim X As Long, bi As BROWSEINFO, dwIList As Long
351 Dim szPath As String, wPos As Integer
352
353 With bi
354 .hOwner = hWndAccessApp
355 .lpszTitle = szDialogTitle
356 .ulFlags = BIF_RETURNONLYFSDIRS
357 End With
358
359 dwIList = SHBrowseForFolder(bi)
360 szPath = Space$(512)
361 X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
362
363 If X Then
364 wPos = InStr(szPath, Chr(0))
365 BrowseFolder = Left$(szPath, wPos - 1)
366 Else
367 BrowseFolder = ""
368 End If
Module: modMain Page: 23
369 End Function
370
371 Function CurrentDBDir() As String
372 'From an original idea by
373 'Ken Getz
374 '
375 Dim strDBPath As String
376 Dim strDBFile As String
377 strDBPath = CurrentDb.Name
378 strDBFile = Dir(strDBPath)
379 CurrentDBDir = Left(strDBPath, Len(strDBPath) - Len(strDBFile))
380 End Function
381
382 Function fWZ_Init()
383 'Entry point for the wizard
384 '
385 DoCmd.OpenForm "frmDatabases"
386 End Function
387
این متن فقط قسمتی از پایان نامه بانک اطلاعات می باشد
جهت دریافت کل متن ، لطفا آن را خریداری نمایید