| وظيفة getKbStatus (): سلسلة ؛ // العودة إلى حالة لوحة المفاتيح الحالية ، بما في ذلك Numloce ، قفل Caps ، إدراج // كل معلومات حالة تشغل حرفين ، بالترتيب: Numloce ، قفل Caps ، إدراج // نسخ يمين 549@11: 29 2003-7-22 حالة var: سلسلة ؛ KeyStates: TkeyboardState ؛ يبدأ getKeyboardState (keystates) ؛ إذا كان ODD (keystates [vk_numlock]) ثم الحالة: = 'الرقم' آخر الحالة: = 'المؤشر' ؛ إذا كان ODD (keystates [vk_capital]) ثم الحالة: = الحالة+"CAPS" آخر الحالة: = الحالة+'shedcase' ؛ إذا كان ODD (keystates [vk_insert]) ثم الحالة: = الحالة+"إدراج" آخر الحالة: = الحالة+"إعادة كتابة" ؛ النتائج: = الحالة ؛ نهاية const errhead = 'حدث الخطأ في العملية ، رسالة الخطأ هي:'+#13 يحاول ... يستثني على E: استثناء لا ShowMessage (errhead+e.message+#13+'العملية الحالية هي: xxxxx') ؛ نهاية؛ يتيح للمستخدمين رؤية المزيد من رسائل الخطأ ، مما يساعد العملاء على أخطاء برامج التعليق. أكتب فكرة جيدة ، لكنني غالبًا ما أستخدمها: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>> // تنفيذ SQL // معلمات الإدخال: sqlstring ، adoquery // النوع: سلسلة ، tadoquery الإجراء tmainform.exesql (sqlstring: string ؛ adoquery: tadoquery) ؛ يبدأ مع adoquery تفعل يبدأ الاتصال: = dm.dbaccinfo ؛ // هذا هو لي ، يمكنك إضافة الاتصال // أو استخدمه. إذا نشط ثم نشط: = خطأ ؛ يفتح؛ sql.clear ؛ sql.add (sqlstring) ؛ execsql ؛ يغلق؛ نهاية؛ نهاية. ومع ذلك ، في الكود الذي رأيته ، يبدو أن قلة من الناس يكتبون مثل هذه العملية المستقلة. هذا مضمون أن أكون أصليًا بنفسي ... // فتح adoquery // مقتبس من عملية حقيقية (Aixiang (يمكن إخبار Lizzy فقط بأن الآخرين لا يستطيعون))) // دعم SQL متعدد الخط // يمكنك تعديلها بنفسك حسب الحاجة لدعم إجراءات SQL ذات الخط الواحد فقط ، أو إجراءات EXESQL // الاختبار تحت Delphi6 مرت. الإجراء openSql (sqlstring: tstrings ؛ adoquery: tadoquery) ؛ var i: integer ؛ يبدأ مع adoquery تفعل يبدأ يغلق؛ sql.clear ؛ لأني: = 0 إلى sqlstring.count-1 تفعل sql.add (sqlstring [i]) ؛ يحاول يفتح؛ يستثني على E: استثناء لا ShowMessage ('خطأ: الرسالة كما يلي'+#13+e.message) ؛ نهاية؛ نهاية؛ نهاية؛ هذا خط واحد من SQL الإجراء openSql1 (sqlstring: سلسلة ؛ adoquery: tadoquery) ؛ يبدأ مع adoquery تفعل يبدأ يغلق؛ sql.clear ؛ sql.add (sqlstring) ؛ يحاول يفتح؛ يستثني على E: استثناء لا ShowMessage ('خطأ: الرسالة كما يلي'+#13+e.message) ؛ نهاية؛ نهاية؛ نهاية؛ Hoho ، شكرًا لك على مساعدتي في إصلاح هذا الشيء. لكن ألا تستخدم execsql؟ عادةً ما أضيف محاولة خارج هذه العملية ، أي ، حيث يتم نقله. هذا هو المحاولة exesql (sqlstring ، adoquery1) يستثني // موجه خطأ ، أشياء فوضوية. نهاية إلى: على النحو الحقيقي (aixiang (يمكن إخبار ليزي فقط بأن الآخرين لا يستطيعون))) لقد فعلت execsql أيضا // execsql adoquery // دعم SQL متعدد الخط // يمكنك تعديلها بنفسك حسب الحاجة لدعم إجراءات SQL ذات الخط الواحد فقط ، أو إجراءات EXESQL // الاختبار تحت Delphi6 مرت. الإجراء exesql (sqlstring: tstrings ؛ adoquery: tadoquery) ؛ var i: integer ؛ يبدأ مع adoquery تبدأ يغلق؛ sql.clear ؛ لأني: = 0 إلى sqlstring.count-1 تفعل sql.add (sqlstring [i]) ؛ يحاول execsql ؛ يستثني على E: استثناء لا ShowMessage ('خطأ: الرسالة كما يلي'+#13+e.message) ؛ نهاية؛ نهاية؛ نهاية؛ // أعتقد أنه هو نفسه حيث يتم وضعه باستثناء ، من الأفضل وضعه في الخارج لأنه يمكنك إضافة بعض معلومات تصحيح الأخطاء الأخرى //ماذا تعتقد؟ // هل يجمع أي شخص العمليتين لتنفيذ سطر واحد وتنفيذ خطوط متعددة في واحدة ، سيكون ذلك رائعًا. سأفعل اثنين آخرين ، ويمكنني إضافة وحذفها وفقًا لاحتياجاتي ، لكنني أستخدم DBGrideh لإنشاء COL ديناميكيًا الإجراء BuildCol (VfieldName: String ؛ Vcaption: String ؛ vwidth: integer ؛ var vgrid: tdbgrideh ؛ footertype: tfootervaluetype = fvtnon ؛ BoolReadonly: Boolean = true ؛ var CCOL: TDBGRIDCOLUMNEH ؛ cfootercol: tcolumnfootereh ؛ يبدأ ccol: = tdbgridcolumneh.create (vgrid.columns) ؛ ccol.fieldname: = VfieldName ؛ ccol.width: = vwidth ؛ ccol.title.caption: = vcaption ؛ ccol.title.alignment: = tacenter ؛ ccol.title.color: = vcolor ؛ ccol.Readonly: = boolReadonly ؛ // إذا كانت قيمة العلامة -1 ، فلن يتم طباعة العمود عند طباعة DBGRID ccol.tag: = itag ؛ يبدأ cfootercol: = ccol.footers.add ؛ cfootercol.valuetype: = footertype ؛ إذا كان footertype = fvtstatictext ثم يبدأ vgrid.footerrowCount: = 1 ؛ cfootercol.value: = footertext ؛ نهاية؛ //ccol.footer.fieldname:= ؛ نهاية؛ نهاية ؛ الإجراء titlebtnclick (المرسل: tobject ؛ acol: integer ؛ العمود: tcolumneh ؛ var CDSTMP: TclientDataset ؛ يبدأ مع (المرسل كما tdbgrideh) تفعل يبدأ CDSTMP: = (datasource.dataset as tclientDataset) ؛ إن لم يكن CDSTMP.Active ثم الخروج ؛ // قم بتعيين طريقة الفرز للصف الحالي if column.title.sortmarker = smnoneeh ثم يبدأ column.title.sortmarker: = smupeh ؛ cdshelper.sortbyfield (column.fieldname ، soascending) ؛ نهاية آخر if column.title.sortmarker = smupeh ثم يبدأ column.title.sortmarker: = smdowneh ؛ cdshelper.sortbyfield (column.fieldname ، sodescending) ؛ نهاية آخر يبدأ column.title.sortmarker: = smnoneeh ؛ cdshelper.sortbyfield (column.fieldname ، sonosort) ؛ نهاية؛ نهاية؛ النهاية ؛ الإجراء f_readini (const now_dbgrid: tdbgrid ؛ form_name: string) ؛ var FilePath: سلسلة ؛ myinifile: tinifile. Grid_name ، field_name: string ؛ العرض: عدد صحيح ؛ أنا ، ي ، ن: عدد صحيح ؛ العمود: صفيف [0..100] من السلسلة ؛ العروض: صفيف [0..100] من عدد صحيح ؛ يبدأ FilePath: = extractFilePath (application.exename) ؛ myinifile: = tinifile.create (filepath+'gsp.ini') ؛ Grid_name: = form_name+'،'+now_dbgrid.name ؛ n: = now_dbgrid.columns.count-1 ؛ لأني: = 0 إلى n do يبدأ field_name: = now_dbgrid.columns [i] .FieldName ؛ J: = myinifile.ReadInteger (Grid_name ، field_name ، i) ؛ العمود [J]: = field_name ؛ عرض [j]: = myinifile.ReadInteger (grid_name ، field_name+'_ width' ، now_dbgrid.columns [i] .width) ؛ نهاية يبدأ now_dbgrid.columns [i] .fieldName: = column [i] ؛ now_dbgrid.columns [i]. width: = widths [i] ؛ نهاية end ؛ الإجراء f_writeini (const now_dbgrid: tdbgrid ؛ form_name: string) ؛ var FilePath: سلسلة ؛ myinifile: tinifile. Grid_name ، field_name: string ؛ العرض: عدد صحيح ؛ أنا: عدد صحيح. يبدأ FilePath: = extractFilePath (application.exename) ؛ myinifile: = tinifile.create (filepath+'gsp.ini') ؛ GRID_NAME: = form_name+'،'+now_dbgrid.name ؛ يبدأ field_name: = now_dbgrid.columns [i] .FieldName ؛ العرض: = now_dbgrid.columns [i] .width ؛ myinifile.writeInteger (grid_name ، field_name ، i) ؛ myinifile.writeInteger (grid_name ، field_name+'_ width' ، width) ؛ نهاية نهاية. وحدة myfunc ؛ واجهة يستخدم Windows ، sysutils ، mmsystem ، WinSVC ، registry ؛ وظيفة copystrleft (ch: char ؛ str: string): string ؛ وظيفة copystrright (CH: char ؛ str: سلسلة): سلسلة ؛ وظيفة GetselfPath: سلسلة. الإجراءات Hidetask (Bhide: Boolean) ؛ وظيفة SoundCardInstalled: Boolean ؛ وظيفة gethostip: سلسلة. الإجراء تعطيل (svcName: سلسلة) ؛ وظيفة getRegisteredOwner: سلسلة. وظيفة GetSteRedorganization: String. يبدأ النتائج: = نسخة (str ، 1 ، pos (ch ، str) -1) نهاية ؛ وظيفة copystrright (CH: char ؛ str: سلسلة): سلسلة ؛ يبدأ النتائج: = نسخة (str ، pos (ch ، str) +1 ، الطول (str) -pos (ch ، str) +1) نهاية ؛ وظيفة getselfpath: سلسلة. يبدأ النتيجة: = extractfilepath (paramstr (0)) النهاية ؛ الإجراءات Hidetask (Bhide: Boolean) ؛ يبدأ إذا bhide ثم ReciterserviceProcess (getCurrentProcessid ، 1) Else RegisterServiceProcess (getCurrentProcessid ، 0) ؛ نهاية ؛ وظيفة صوتية صوتية: منطقية ؛ يبدأ النتيجة: = WaveOtgetNumDevs> 0 نهاية ؛ وظيفة gethostip: سلسلة. يكتب tapinaddr = صفيف [0..10] من pinaddr ؛ papinaddr = ^tapinaddr ؛ var PHE: Phostent ؛ PPTR: Papinaddr ؛ المخزن المؤقت: صفيف [0..63] من char ؛ أنا: عدد صحيح. Ginitdata: Twsadata ؛ يبدأ WSASTARTUP (101 دولار ، جينيتا) ؛ gethostname (Buffer ، sizeof (buffer)) ؛ PHE: = gethostbyname (العازلة) ؛ إذا phe = nil ثم الخروج ؛ pptr: = papinaddr (phe^.h_addr_list) ؛ أنا: = 0 ؛ النتيجة: = inet_ntoa (pptr^[i]^) ؛ wsacleanup نهاية ؛ الإجراء تعطيل (svcName: سلسلة) ؛ var Scmngr: Thandle ؛ SCSVC: Thandle ؛ يبدأ scmngr: = openscmanager (nil ، nil ، sc_manager_all_access) ؛ SCSVC: = OpenService (SCMNGR ، SVCNAME ، service_change_config) ؛ changeviceConfig (SCSVC ، service_no_change ، service_disabled ، service_no_change ، nil ، nil ، nil ، nil ، nil ، nil ، nil) ؛ CloseServiceHandle (SCSVC) ؛ نهاية ؛ وظيفة getRegisteredOwner: سلسلة. var التباين: tosversioninfo ؛ Swinkey: سلسلة. يبدأ insversion.dwosversionInfosize: = sizeof (osversion) ؛ getVersionex (الأداء) ؛ case isversion.dwplatformid من ver_platform_win32_windows: swinkey: = '/software/microsoft/windows/currentVersion' ؛ ver_platform_win32_nt: swinkey: = '/software/microsoft/windows nt/currentVersion' ؛ نهاية؛ مع tregistry.create تفعل يحاول Rootkeke: = HKEY_LOCAL_MACHINE ؛ OpenKey (Swinkey ، false) ؛ النتيجة: = readString ('registered alminer') ؛ أخيراً حر؛ نهاية؛ نهاية ؛ وظيفة getRegisteredorganization: سلسلة. var التباين: tosversioninfo ؛ Swinkey: سلسلة. يبدأ insversion.dwosversionInfosize: = sizeof (osversion) ؛ getVersionex (الأداء) ؛ case isversion.dwplatformid من ver_platform_win32_windows: swinkey: = '/software/microsoft/windows/currentVersion' ؛ ver_platform_win32_nt: swinkey: = '/software/microsoft/windows nt/currentVersion' ؛ نهاية؛ مع tregistry.create تفعل يحاول Rootkeke: = HKEY_LOCAL_MACHINE ؛ OpenKey (Swinkey ، false) ؛ النتيجة: = readString ('registeredorganization') ؛ أخيراً حر؛ نهاية؛ نهاية؛ نهاية. ضع بضع // حذف جميع ملفات الامتداد المحددة في دليل معين دالة delfile (sdir ، fext: سلسلة): منطقية ؛ var hfindfile: hwnd ؛ FindFileData: win32_find_data ؛ SR: tsearchrec ؛ يبدأ sdir: = sdir + '/' ؛ hfindfile: = findFirstFile (pchar (sdir + fext) ، findFileData) ؛ إذا كان hfindfile <> null ثم يبدأ DELETEFILE (SDIR + FindFileData.cfilename) ؛ بينما FindNextFile (hfindfile ، findfiledata) <> false افعل DELETEFILE (SDIR + FindFileData.cfilename) ؛ نهاية؛ sr.findhandle: = hfindfile ؛ FindClose (SR) ؛ نهاية ؛ // تأخير الإجراء mdelay (msecs: dword) ؛ var Begintime: Dword ؛ يبدأ Begintime: = getTickCount ؛ يكرر Application.ProcessMessages ؛ حتى getTickCount - begintime> = msecs ؛ نهاية ؛ // تنسيق نوع نقطة العائمة وظيفة my_formatfloat (r: real ؛ u: integer): real ؛ var VSTR: سلسلة ؛ أنا: عدد صحيح. يبدأ إذا كنت <= 0 ثم النتائج: = ص آخر يبدأ VSTR: = '0' ؛ لأني: = 1 إلى u - 1 تفعل VSTR: = VSTR + '0' ؛ VSTR: = '0.' + VSTR ؛ النتيجة: = strtofloat (formatfloat (vstr ، r)) ؛ نهاية؛ النهاية ؛ // احصل على السلسلة الفرعية في الموضع المحدد في سلسلة معينة // على سبيل المثال ، get_substr ('aa ## bb#cc ## dd' ، '##' ، 3) إرجاع 'cc' وظيفة get_substr (S_STR ، D_STR: PO: integer): String ؛ var أنا ، ي ، ك: عدد صحيح ؛ يبدأ النتيجة: = '' ؛ إذا po <1 ثم مخرج؛ S_STR: = trim (S_STR)+D_STR ؛ أنا: = 0 ؛ بينما 1 = 1 تفعل يبدأ إذا pos (d_str ، s_str)> 0 ثم يبدأ j: = pos (d_str ، s_str)+length (d_str) ؛ K: = الطول (S_STR)-(J-1) ؛ i: = i+1 ؛ إذا كنت = بو ثم يبدأ j: = pos (d_str ، s_str) ؛ النتيجة: = نسخة (S_STR ، 1 ، J-1) ؛ استراحة؛ نهاية؛ S_STR: = COPY (S_STR ، J ، K) ؛ نهاية آخر استراحة؛ نهاية؛ نهاية ؛ // احصل على أول ونهاية شهر التاريخ الحالي وظيفة get_date (da: tdateTime ؛ ZT: عدد صحيح): tdatetime ؛ var YY ، MM ، DD: String ؛ يبدأ yy: = formatdatetime ('yyyy' ، da) ؛ mm: = formatdatetime ('mm' ، da) ؛ إذا ZT = 0 ثم DD: = '01' آخر يبدأ إذا كان strtoint (مم) في [1،3،5،7،8،10،12] ثم DD: = '31' آخر إذا mm <> '2' ثم DD: = '30' آخر إذا isLeapyear (yearof (da)) ثم DD: = '29' آخر DD: = '28' ؛ نهاية؛ dateseparator: = '-' ؛ النتيجة: = strtodate (yy + '-' + mm + '-' + dd) ؛ نهاية ؛ // وجود أو لا من الجدول وظيفة isexist (السل: سلسلة ؛ الاستعلام: tadoquery): منطقية ؛ var SQLSTR: سلسلة ؛ يبدأ sqlstr: = 'حدد * من sysobjects حيث id = object_id (' '+tb+' '') '؛ مع الاستعلام تفعل يبدأ يغلق؛ sql.clear ؛ sql.add (sqlstr) ؛ يفتح؛ نهاية؛ إذا Query.RecordSet.eof ثم Isexist: = خطأ آخر isexist: = صحيح ؛ نهاية ؛ // الاستخدام في Excel ، فإنه يعادل التحويل السداسي السداسي وظيفة int2letter (num: integer): سلسلة ؛ كونست letterstr = 'abcdefghijklmnopqrstuvwxyz' ؛ var أنا ، ي: عدد صحيح ؛ يبدأ إذا num <= 26 ثم يبدأ النتيجة: = Letterstr [num] ؛ نهاية آخر يبدأ J: = num mod 26 ؛ i: = num div 26 ؛ إذا J = 0 ثم يبدأ J: = 26 ؛ أنا: = I-1 ؛ نهاية؛ النتيجة: = int2letter (i)+Letterstr [j] ؛ نهاية؛ نهاية ؛ // هل هو نوع عدد صحيح وظيفة ISINT (AST: سلسلة): منطقية ؛ var القيمة ، الرمز: عدد صحيح ؛ يبدأ Val (Astr ، Value ، Code) ؛ النتيجة: = الكود = 0 ؛ نهاية؛ // هل هو نوع نقطة العائمة وظيفة iSfloat (Astr: String): Boolean ؛ var القيمة: حقيقية ؛ الكود: عدد صحيح ؛ يبدأ Val (Astr ، Value ، Code) ؛ النتيجة: = الكود = 0 ؛ تنتهي. الإجراء RunScreenSave () ؛ //-تشغيل حماية الشاشة يبدأ SendMessage (HWND_Broadcast ، WM_SYSCOMMAND ، SC_SCREENSAVE ، 0) ؛ نهاية؛ // يتم تقريب الوظيفتين التاليتين ، بشكل رئيسي لإظهار طريقة للتفكير ، يمكنك استخدام أي منها وظيفة myRound (القيمة: مزدوجة): عدد صحيح ؛ // ملء وجولة // هذه حقوق الطبع والنشر تنتمي إلى Xiaofeng يبدأ النتيجة: = strtoint (formatfloat ('#' ، value)) ؛ نهاية ؛ وظيفة doround (القيمة: مزدوجة): عدد صحيح ؛ // ملء وجولة // لدي نصف هذا ، هاها. يبدأ إذا كانت القيمة <0 ثم النتائج: = - doround ( -قيمة) آخر النتيجة: = الجولة (int ((القيمة + 0.5) * 10)) div 10 ؛ نهاية؛ // بالطبع ، هناك طرق أخرى لكتابة هذه الوظيفة. . . ملاحظات إضافية: تتبنى وظيفة المستديرة نفسها قاعدة "التقريب إلى خمسة إلى خمسة زوجات". أنشر أيضًا بعض استخداماتي المشتركة: {------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------ اسم العملية: MSG المؤلف: Gongqin التاريخ: 2003-6-9 16:57:44 المعلمات: amsg: atitle: string = 'tip' ؛ anype: = 1 عرض رمز "المعلومات" 2 عرض رمز "الخطأ" AMSG (محتوى رسالة العرض) atitle (عنوان العرض) BTN: = 0 عرض موافق 1 عرض موافق إلغاء 2 تظهر نعم لا 3 إظهار إعادة المحاولة وإلغاء 4 عرض الإجهاض ، إعادة المحاولة ، وتجاهل قيمة الإرجاع: عدد صحيح الوصف: مربع الحوار عرض رسالة ------------------------------------------------- ------------------------------------------------- ---------------------------- ----------------------- --------------} وظيفة msg (AMSG: string ؛ atitle: string ؛ atype: byte ؛ btn: longint): integer ؛ فار العلم: longint ؛ يبدأ قضية anype من 1: العلم: = mb_iconquestion ؛ 2: العلم: = MB_ICONERROR ؛ 3: العلم: = MB_ICONSTOP ؛ آخر العلم: = mb_iconwarning ؛ نهاية؛ قضية btn من 0: Flag: = flag + mb_ok ؛ 1: Flag: = flag + mb_okcancel ؛ 2: Flag: = flag + mb_yesno ؛ 3: العلم: = العلم + MB_YESNOCANCEL ؛ 4: Flag: = flag + mb_retrycancel ؛ 5: Flag: = flag + mb_abortretryignore ؛ نهاية؛ النتيجة: = application.messagebox (PCHAR (AMSG) ، PCHAR (atitle) ، flag) ؛ نهاية؛{----------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------------------------------------------------- ------ اسم العملية: getapppath المؤلف: Gongqin التاريخ: 2003-6-9 17:01:17 المعلمات: لا شيء قيمة الإرجاع: سلسلة الوصف: خذ المسار إلى التطبيق إذا كنت تستخدم فقط extractfilepath (extractFilePath (application.exename)) للحصول على المسار قد يكون هناك خطأ ، لذلك تمت معالجته ------------------------------------------------- ------------------------------------------------- ---------------------------- ----------------------- --------------} وظيفة getapppath: سلسلة. var Strtmp: سلسلة ؛ يبدأ strtmp: = extractFilePath (extractFilePath (application.exename)) ؛ إذا strtmp [الطول (strtmp)] <> '/' ثم strtmp: = strtmp + '/' ؛ النتيجة: = strtmp ؛ نهاية؛ أدناه هو ما قمت بتجميعه بنفسي http://www.myf1.net/bbs/dispbbs.asp؟boardid=5&id=215239 // احسب الشهر الأول والأخير من الربع حيث يوجد التاريخ الحالي // Ultimate Edition وظيفة Quarterbegin (thedate: tdatetime = 0): عدد صحيح ؛ // نسخ يمين 549@18: 25 2003-9-3 يبدأ النتيجة: = (الربع (thedate) - 1) * 3 + 1 ؛ نهاية ؛ وظيفة Quarterend (thedate: tdatetime = 0): عدد صحيح ؛ // نسخ يمين 549@18: 25 2003-9-3 يبدأ النتيجة: = (الربع (thedate) - 1) * 3 + 3 ؛ نهاية ؛ ربع الوظيفة (thedate: tdatetime = 0): عدد صحيح ؛ // نسخ يمين 549@10: 06 2003-9-5 يبدأ النتيجة: = شهر (thedate) ؛ إذا thedate = 0 ثم النتيجة: = monthof (date) ؛ النتيجة: = (النتيجة + 2) div 3 ؛ نهاية؛ | 