| fungsi getKbstatus (): string; // Kembali ke status keyboard saat ini, termasuk NumLoce, Caps Lock, Insert // Setiap informasi status menempati dua karakter, dalam urutan: numloce, caps lock, masukkan // Salin kanan 549@11: 29 2003-7-22 Status var: string; Keystates: TKeyboardState; Mulai GetKeyboardState (Keystates); Jika ganjil (keystates [vk_numlock]) lalu Status: = 'angka' kalau tidak Status: = 'kursor'; Jika ganjil (keystates [vk_capital]) lalu Status: = Status+'Caps' kalau tidak Status: = status+'huruf kecil'; Jika ganjil (keystates [vk_insert]) lalu Status: = Status+'Sisipkan' kalau tidak Status: = Status+'Tulis ulang'; Hasil: = status; akhir; const errhead = 'kesalahan terjadi dalam operasi, pesan kesalahan adalah:'+#13 mencoba ... kecuali pada e: pengecualian do showmessage (errhead+e.message+#13+'Operasi saat ini adalah: xxxxx'); akhir; Ini memungkinkan pengguna untuk melihat lebih banyak pesan kesalahan, yang membantu pelanggan umpan balik kesalahan program. Saya menulis ide yang bagus, tetapi saya sering menggunakannya: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>> // Jalankan SQL // Parameter input: sqlstring, adoquery // Ketik: String, Tadoquery Prosedur tMainForm.exesql (sqlstring: string; adoquery: tadoquery); Mulai dengan adoquery lakukan Mulai Koneksi: = dm.dbaccinfo; // Ini milik saya, Anda dapat menambahkan koneksi // atau gunakan. Jika aktif maka Aktif: = false; Membuka; Sql.clear; Sql.add (sqlstring); Execsql; Menutup; akhir; Akhirnya; Namun, dalam kode yang saya lihat, tampaknya sedikit orang yang menulis proses independen. Ini dijamin asli sendiri ... // Buka Adoquery // Diadaptasi dari proses nyata (Aixiang (hanya Lizzy yang dapat diberitahu bahwa orang lain tidak bisa)) // Mendukung SQL multi-line // Anda dapat memodifikasinya sendiri sesuai kebutuhan hanya untuk mendukung prosedur SQL baris tunggal, atau prosedur EXESQL // Tes di bawah Delphi6 lulus. Prosedur OpenSQL (SQLString: TStrings; Adoquery: Tadoquery); Var I: Integer; Mulai dengan adoquery lakukan Mulai Menutup; Sql.clear; untuk i: = 0 ke sqlstring.count-1 do Sql.add (sqlstring [i]); mencoba Membuka; kecuali pada e: pengecualian do showmessage ('kesalahan: pesannya adalah sebagai berikut'+#13+e.message); akhir; akhir; akhir; Ini adalah satu baris SQL Prosedur OpenSQL1 (SQLString: String; Adoquery: Tadoquery); Mulai dengan adoquery lakukan Mulai Menutup; Sql.clear; Sql.add (sqlstring); mencoba Membuka; kecuali pada e: pengecualian do showmessage ('kesalahan: pesannya adalah sebagai berikut'+#13+e.message); akhir; akhir; akhir; Hoho, terima kasih telah membantu saya memperbaiki hal ini. Tapi apakah Anda tidak menggunakan execsql? Saya biasanya menambahkan mencoba di luar proses ini, yaitu, di mana dia dikutip. Itu coba Exesql (sqlstring, adoquery1) kecuali // prompt kesalahan, barang berantakan. akhir to: real like (aixiang (hanya Lizzy yang dapat diberi tahu bahwa orang lain tidak bisa)) Saya juga melakukan execsql // Execsql Adoquery // Mendukung SQL multi-line // Anda dapat memodifikasinya sendiri sesuai kebutuhan hanya untuk mendukung prosedur SQL baris tunggal, atau prosedur EXESQL // Tes di bawah Delphi6 lulus. Prosedur ExESQL (SQLString: TStrings; Adoquery: Tadoquery); Var I: Integer; Mulai dengan adoquery mulai Menutup; Sql.clear; untuk i: = 0 ke sqlstring.count-1 do Sql.add (sqlstring [i]); mencoba Execsql; kecuali pada e: pengecualian do showmessage ('kesalahan: pesannya adalah sebagai berikut'+#13+e.message); akhir; akhir; akhir; // Saya pikir itu sama di mana kecuali ditempatkan, lebih baik meletakkannya di luar karena, Anda dapat menambahkan beberapa informasi debugging lainnya //Bagaimana menurutmu? // Apakah siapa pun menggabungkan dua proses mengeksekusi satu baris dan mengeksekusi beberapa baris menjadi satu, itu akan sangat bagus. Saya akan melakukan dua lagi, dan saya dapat menambahkan dan menghapusnya sesuai dengan kebutuhan saya, tetapi saya menggunakan dbgrideh untuk secara dinamis membuat col Prosedur BuildCol (VFieldName: String; VCaption: String; VWidth: Integer; Var vgrid: tdbgrideh; FooterType: tfootervAluetype = fvtnon; boolreadonly: boolean = true; var CCOL: TDBGRIDCOLUMNEH; Cfootercol: tcolumnfootereh; Mulai 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; // Jika nilai tag -1, kolom tidak akan dicetak saat mencetak dbgrid CCOL.TAG: = ITAG; Mulai cfootercol: = ccol.footers.add; cfootercol.valuetype: = footertype; Jika footertype = fvtstatictext maka Mulai vgrid.footerrowcount: = 1; cfootercol.value: = footertext; akhir; //ccol.footer.fieldname :=; akhir; end; Prosedur TitleBtnClick (pengirim: Tobject; acol: integer; Kolom: tcolumneh; var CDSTMP: TClientDataSet; Mulai dengan (pengirim sebagai tdbgrideh) lakukan Mulai CDSTMP: = (DataSource.Dataset sebagai TClientDataSet); Jika tidak cdstmp.active maka keluar; // Atur metode penyortiran baris saat ini Jika kolom.title.sortmarker = smnoneeh lalu Mulai Kolom.title.sortmarker: = smupeh; cdshelper.sortbyfield (Column.FieldName, soascending); akhir kalau tidak Jika kolom.title.sortmarker = smupeh lalu Mulai Kolom.title.sortmarker: = smdowneh; cdshelper.sortbyfield (column.fieldname, sodescending); akhir kalau tidak Mulai Kolom.title.sortmarker: = smnoneeh; cdshelper.sortbyfield (Column.FieldName, Sonosort); akhir; akhir; akhir; Prosedur f_readini (const now_dbgrid: tdbgrid; form_name: string); var Filepath: string; Myinifile: Tinifile; Grid_name, field_name: string; Lebar: Integer; I, J, N: Integer; Kolom: array [0..100] dari string; Lebar: array [0..100] dari Integer; Mulai FilePath: = ExtractFilePath (Application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; n: = now_dbgrid.columns.count-1; untuk i: = 0 hingga 100 do kolom [i]: = ''; untuk i: = 0 hingga n lakukan Mulai Field_name: = now_dbgrid.columns [i] .fieldName; J: = myinifile.readInteger (grid_name, field_name, i); Kolom [j]: = field_name; Lebar [j]: = myinifile.readInteger (grid_name, field_name+'_ lebar', now_dbgrid.columns [i] .width); akhir; Mulai Now_dbgrid.columns [i] .fieldName: = kolom [i]; Now_dbgrid.columns [i] .width: = lebar [i]; akhir; end; Prosedur f_writeini (const now_dbgrid: tdbgrid; form_name: string); var Filepath: string; Myinifile: Tinifile; Grid_name, field_name: string; Lebar: Integer; I: Integer; Mulai FilePath: = ExtractFilePath (Application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; Mulai Field_name: = now_dbgrid.columns [i] .fieldName; Lebar: = now_dbgrid.columns [i] .width; Myinifile.writeInteger (grid_name, field_name, i); Myinifile.writeInteger (grid_name, field_name+'_ width', lebar); akhir; Akhirnya; unit myfunc; antarmuka penggunaan Windows, sysutils, mmsystem, winsvc, registry; fungsi copystrleft (ch: char; str: string): string; fungsi copystrright (ch: char; str: string): string; fungsi getselfpath: string; Prosedur Hidetask (Bhide: Boolean); Fungsi SoundCardin Installed: Boolean; function gethostip: string; Prosedur DisablyVC (SVCName: String); fungsi getregisteredowner: string; Fungsi Getregisteredederngaization: String; Mulai Hasil: = Salin (str, 1, pos (ch, str) -1) end; function copystrright (ch: char; str: string): string; Mulai Hasil: = Salin (str, pos (ch, str) +1, panjang (str) -pos (ch, str) +1) end; function getselfpath: string; Mulai Hasil: = ExtractFilePath (paramstr (0)) end; Prosedur Hidetask (Bhide: Boolean); Mulai Jika Bhide maka RegisterServiceProcess (GetCurrentProcessId, 1) lain registerserviceProcess (getCurrentProcessId, 0); end; function soundcardinstalled: boolean; Mulai Hasil: = WaveOutGetNumDevs> 0 end; function gethostip: string; jenis Tapinaddr = array [0..10] dari pinaddr; Papinaddr = ^tapinaddr; var phe: fosten; PPTR: Papinaddr; Buffer: array [0..63] dari char; I: Integer; Ginitdata: twsadata; Mulai Wsastartup ($ 101, ginitdata); Gethostname (buffer, sizeof (buffer)); phe: = gethostbyname (buffer); jika phe = nil maka keluar; pptr: = papinaddr (phe^.h_addr_list); I: = 0; Hasil: = inet_ntoa (pptr^[i]^); WSACLEANUP; end; Prosedur disablevc (svcname: string); var SCMNGR: Thandle; SCSVC: Thandle; Mulai scmngr: = OpenScManager (nil, nil, sc_manager_all_access); scsvc: = OpenService (scmngr, svcname, service_change_config); ChangeserviceConfig (SCSVC, Service_no_change, Service_disabled, Service_no_change, nil, nil, nil, nil, nil, nil, nil); CloseServiceHandle (SCSVC); end; function getregisteredowner: string; var Osversion: tosversioninfo; Swinkey: String; Mulai Osversion.dwosversioninfosize: = sizeof (osversion); GetVersionex (osversion); case osversion.dwplatformid dari Ver_platform_win32_windows: swinsey: = '/software/microsoft/windows/currentVersion'; Ver_platform_win32_nt: swinsey: = '/software/microsoft/windows nt/currentVersion'; akhir; dengan Tregistry.Create do mencoba Rootkey: = hkey_local_machine; OpenKey (Swinkey, False); Hasil: = readString ('terdaftar'); Akhirnya Bebas; akhir; end; function getregisteredorganization: string; var Osversion: tosversioninfo; Swinkey: String; Mulai Osversion.dwosversioninfosize: = sizeof (osversion); GetVersionex (osversion); case osversion.dwplatformid dari Ver_platform_win32_windows: swinsey: = '/software/microsoft/windows/currentVersion'; Ver_platform_win32_nt: swinsey: = '/software/microsoft/windows nt/currentVersion'; akhir; dengan Tregistry.Create do mencoba Rootkey: = hkey_local_machine; OpenKey (Swinkey, False); Hasil: = readString ('Registerederorganisasi'); Akhirnya Bebas; akhir; akhir; akhir. Letakkan beberapa pertama // hapus semua file ekstensi yang ditentukan di direktori tertentu fungsi delfile (sdir, fext: string): boolean; var hfindfile: hwnd; FindFiledata: win32_find_data; sr: tsearchrec; Mulai sdir: = sdir + '/'; hfindfile: = findFirstFile (pchar (sdir + fext), findFiledata); Jika hfindfile <> null maka Mulai deleteFile (sdir + findfiledata.cfilename); Sambil findNextFile (hfindfile, findfiledata) <> false do deleteFile (sdir + findfiledata.cfilename); akhir; sr.findhandle: = hfindfile; Findclose (sr); akhir; // tunda Prosedur MDelay (MSEC: DWORD); var BeginTime: DWORD; Mulai BeginTime: = getTickCount; mengulang Application.ProcessMessages; Sampai getTickCount - BeginTime> = msecs; akhir; // format jenis titik mengambang function my_formatfloat (r: real; u: integer): nyata; var vstr: string; I: Integer; Mulai Jika u <= 0 maka Hasil: = r kalau tidak Mulai vstr: = '0'; untuk i: = 1 to u - 1 do VSTR: = VSTR + '0'; VSTR: = '0.' + VSTR; Hasil: = strtofloat (formatFloat (vstr, r)); akhir; end; // Dapatkan substring pada posisi yang ditentukan dalam string tertentu // Misalnya, get_substr ('aa ## bb#cc ## dd', '##', 3) mengembalikan 'cc' function get_substr (s_str, d_str: string; po: integer): string; // s_str string besar, pemisah d_str, posisi po var I, J, K: Integer; Mulai Hasil: = ''; Jika PO <1 maka KELUAR; s_str: = trim (s_str)+d_str; I: = 0; sedangkan 1 = 1 lakukan Mulai if pos (d_str, s_str)> 0 lalu Mulai j: = pos (d_str, s_str)+panjang (d_str); k: = panjang (s_str)-(j-1); I: = i+1; Jika saya = PO maka Mulai j: = pos (d_str, s_str); Hasil: = salin (s_str, 1, j-1); merusak; akhir; s_str: = copy (s_str, j, k); akhir kalau tidak merusak; akhir; akhir; // Dapatkan bulan pertama dan akhir dari tanggal saat ini function get_date (da: tdateTime; zt: integer): tdateTime; var yy, mm, dd: string; Mulai yy: = formatDateTime ('yyyy', da); mm: = formatDateTime ('mm', da); Jika zt = 0 lalu dd: = '01' kalau tidak Mulai Jika strtoint (mm) di [1,3,5,7,8,10,12] maka dd: = '31' kalau tidak Jika mm <> '2' maka DD: = '30' kalau tidak jika isleapyear (tahun (da)) maka DD: = '29' kalau tidak DD: = '28'; akhir; DateSeparator: = '-'; Hasil: = strtodate (yy + '-' + mm + '-' + dd); akhir; // keberadaan atau tidak dari tabel function isExist (TB: String; Query: Tadoquery): boolean; var sqlstr: string; Mulai sqlstr: = 'pilih * dari sysObjects di mana id = object_id (' '+tb+' '') '; dengan kueri lakukan Mulai menutup; sql.clear; sql.add (sqlstr); membuka; akhir; Jika query.recordset.eof maka Isexist: = false kalau tidak IsExist: = true; akhir; // Gunakan di Excel, setara dengan konversi heksadesimal fungsi int2letter (num: integer): string; const Letterstr = 'abcdefghijklmnopqrstuvwxyz'; var I, J: Integer; Mulai Jika num <= 26 maka Mulai Hasil: = lettertr [num]; akhir kalau tidak Mulai J: = num mod 26; I: = Num Div 26; Jika j = 0 lalu Mulai J: = 26; I: = I-1; akhir; Hasil: = int2letter (i)+lettertr [j]; akhir; akhir; // apakah itu tipe integer function isint (AST: string): boolean; var Nilai, kode: bilangan bulat; Mulai Val (astrus, nilai, kode); Hasil: = kode = 0; akhir; // apakah itu tipe titik mengambang Fungsi ISFLOAT (Astr: String): Boolean; var Nilai: Nyata; Kode: Integer; Mulai Val (astrus, nilai, kode); Hasil: = kode = 0; Akhiri; Prosedur RunScreenSave (); //-Jalankan perlindungan layar Mulai SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); akhir; // Dua fungsi berikut ini dibulatkan, terutama untuk menunjukkan cara berpikir, Anda dapat menggunakan salah satunya function myround (nilai: ganda): integer; // Isi dan bulat // hak cipta ini milik Xiaofeng Mulai Hasil: = strtoint (formatFloat ('#', value)); end; function doround (nilai: ganda): integer; // Isi dan bulat // Saya punya setengah dari ini, haha. Mulai Jika nilai <0 maka hasilnya: = - doround (-value) kalau tidak Hasil: = bundar (int ((nilai + 0,5) * 10)) div 10; akhir; // Tentu saja, ada cara lain untuk menulis fungsi ini. . . Catatan Tambahan: Fungsi bundar itu sendiri mengadopsi aturan "membulatkan enam menjadi lima ganda". Saya juga memposting beberapa kegunaan umum saya: {------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nama Proses: Msg Penulis: Gongqin Tanggal: 2003-6-9 16:57:44 Parameter: AMSG: String; Atype: = 1 Tampilkan ikon "Informasi" 2 Tampilkan ikon "Kesalahan" AMSG (Konten Pesan Tampilkan) Atitle (Judul Tampilan) BTN: = 0 Tampilkan OK 1 tunjukkan ok batal 2 Tampilkan Ya Tidak 3 Tampilkan coba lagi dan batal 4 Tunjukkan abort, coba lagi, dan abaikan Nilai Pengembalian: Integer Deskripsi: Tampilkan kotak dialog pesan -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} fungsi msg (AMSG: string; atitle: string; atype: byte; btn: longint): integer; Var Flag: Longint; Mulai case atype dari 1: bendera: = MB_ICONQUESTION; // Ajukan pertanyaan 2: bendera: = mb_iconerror; // kesalahan 3: Bendera: = MB_ICONSTOP; // Berhenti kalau tidak Bendera: = MB_ICONWARNING; akhir; kasus btn dari 0: Bendera: = Bendera + MB_OK; 1: Bendera: = Bendera + MB_OKCANCEL; 2: bendera: = flag + mb_yesno; 3: bendera: = flag + mb_yesnocancel; 4: Bendera: = Bendera + MB_RETRYCANCEL; 5: flag: = flag + mb_abortretryignore; akhir; Hasil: = Application.MessageBox (PCHAR (AMSG), PCHAR (Atitle), Flag); akhir;{----------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nama Proses: GetApppath Penulis: Gongqin Tanggal: 2003-6-9 17:01:17 Parameter: Tidak ada Nilai Pengembalian: String Deskripsi: Ambil jalur ke aplikasi Jika Anda hanya menggunakan ExtractFilePath (ExtractFilePath (Application.exename)) untuk mendapatkan jalur Mungkin ada kesalahan, jadi itu diproses -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} fungsi getApppath: string; var strtmp: string; Mulai strtmp: = ExtractFilePath (ExtractFilePath (Application.exename)); Jika strtmp [panjang (strtmp)] <> '/' lalu strtmp: = strtmp + '/'; Hasil: = strtmp; akhir; Di bawah ini adalah apa yang telah saya kumpulkan sendiri http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 // Hitung bulan pertama dan lalu dari kuartal di mana tanggal saat ini berada // Edisi Ultimate Function quarterbegin (Thedate: tDateTime = 0): integer; // Salin kanan 549@18: 25 2003-9-3 Mulai Hasil: = (kuartal (Thedate) - 1) * 3 + 1; end; function quarterend (thedate: tDateTime = 0): integer; // Salin kanan 549@18: 25 2003-9-3 Mulai Hasil: = (kuartal (Thedate) - 1) * 3 + 3; end; function quarter (tDateTime = 0): integer; // Salin kanan 549@10: 06 2003-9-5 Mulai Hasil: = Bulan (THEDATE); jika tedat = 0 maka hasilnya: = bulan (tanggal); Hasil: = (Hasil + 2) Div 3; akhir; | 